为 什么 要 写 这 本 书 


本 书 是 我 写 的 “R 的 极 客 理想 ”系列 丛书 的 第 二 本 ， 主 要 介绍 了 R 语 言 本 身 的 核心 技术 、Ri 语 言 的 高 级 开发 应 用 、R 语 言 与 其 他 学 科 及 知识 领域 的 跨 学 科 综 合 应 用 。 


程 中 。 但 由 于 一 本 书 的 篇 幅 有 限 ，《R 的 极 客 理想 一 一 工具 篇 》 只 讲 了 如 何 使 用 R 语 言 ， 没 有 讲 原理 。 


其 实 ， 早 在 我 的 第 一 本 书 《R 的 极 客 理想 一 一 工具 篇 》 中， 就 已 经 介绍 了 R 语 言 的 30 多 个 工具 包 的 使 用 方法 ， 并 以 IT 人 的 角度 ， 告 诉 读者 如 何 高 效 地 使 用 第 三 方 R 包 ， 把 原 有 IT 知识 运用 到 R 语 言 的 学 习 过 


而 本 书 将 弥补 这 一 遗憾 ， 主 要 介绍 R 语 言 本 身 的 核心 技术 : 包括 环境 空间 、 面 向 对 象 、 文 件 管理 、 数 学 计算 、R 包 开发 等 主题 。 我 希望 通过 这 本 书 ， 可 以 让 读者 更 深入 地 了 解 Ri 语言、 掌握 R 语 言 的 核心 技 


术 、 理 解 R 语 言 的 第 三 方 包 的 特性 ， 甚 至 可 以 自己 动手 开发 出 属于 自己 风格 的 优秀 R 包 。 说 不 定 ， 不 久 的 将 来 我 会 因 用 到 你 开发 出 来 的 R 包 而 省 力 不 少 。 


除 此 之 外 ， 本 书 的 另 一 大 亮点 就 是 : R 语 言 与 其 他 学 科 知 识 在 不 同 领域 的 跨 学 科 综合 应 用 。 在 书 中 ， 我 将 毫 无 保留 地 向 读者 展示 : 我 是 怎样 将 R 语 言 与 其 他 知识 相 结合 ， 在 不 同 领域 让 R 大 放 异彩 的 。 相 


信 这 部 分 内 容 会 让 很 多 读者 眼前 一 亮 ， 为 之 惊叹 ， 原 来 R 还 可 以 这 么 玩 儿 ! 也 希望 这 部 分 内 容 可 以 让 大 家 有 所 启发 ， 让 各 行业 、 各 知识 领域 的 朋友 都 可 以 接触 R， 运 用 R。 时 至 今日 ，R 语 言 已 经 不 再 是 局 限于 


科学 家 们 使 用 的 实验 室 语言 ， 它 已 经 具备 了 实际 开发 应 用 的 能 力 ， 并 且 在 挖掘 数据 价值 、 发 现 数据 规律 、 创 造 数据 财富 等 方面 极 


智慧 和 创造 性 ! 


如 果 把 R 语 言 比 作 一 门 武 功 ，《R 的 极 客 理想 一 一 工具 篇 》 就 是 兵器 使 用 秘籍 (比如 什么 “ 打 狗 棍 法 ” 啊 、“ 独 孤 九 剑 ” 啊 、 
让 你 在 R 语 言 上 的 修 为 明显 提高 ， 但 时 间 久 了 ， 你 会 因 各 种 原因 遇 到 自己 的 瓶颈， 难以 突破 。 


' 小 李 飞 刀 ” 啊 ) ， 它 可 以 帮助 你 在 短 时 间 内 便捷 、 有 效 地 提高 工作 效率 ， 


而 本 书 则 是 武功 的 内 功 心 法 (比如 什么 《 九 阳 真 经 》、《 北 冥 神功 》 之 类 的 ， 敬 请 对 号 入 座 ， 但 别 拿 《葵花 宝典 》 说 事 儿 ， 谢 谢 ) ， 书 中 不 仅 介绍 了 R 语 言 本 身 的 核心 技术 ， 帮 你 打通 任 督 二 脉 ; 而 且 着 


重 讲述 了 R 语 言 在 实际 使 用 过 程 中 ， 如 何 与 其 他 学 科 、 领 域 结合 运用 ， 融 会 贯通 ， 以 无 招 胜 有 招 ， 甚 至 自立 门派 成 为 一 代 宗师 ， 这 些 都 是 有 可 能 的 ! ( 咳 咳 ， 扯 远 了 ! ) 


在 这 里 ， 我 必须 再 次 严肃 地 强调 ， 本 书 不 是 R 语 言 的 入 门 书 ， 零 基础 的 朋友 要 先 补充 一 些 R 语 言 的 基础 知识 ! 本 书包 括 R 语 言 
一 定 的 计算 机 背景 知识 和 使 用 经 验 ， 只 有 这 样 ， 你 才能 更 深刻 地 体会 并 运用 书 中 的 经 验 总 结 。 


发 的 高 级 内 容 ， 阅 读本 书 ， 不 但 需要 你 有 R 语 言 使 用 经 验 ， 而 且 需要 你 具备 


本 书 的 内 容 完全 是 我 在 R 语 言 的 实际 使 用 过 程 中 总 结 而 成 的 ， 基 本 都 是 我 在 工作 中 使 用 R 语 言 的 真实 记录 ， 以 R 语 言 的 高 级 开发 为 主 ， 其 中 还 涉及 计算 机 、 统 计 、 数 学 和 金融 四 个 学 科 的 知识 。 


本 书 的 核心 内 容 包括 两 方面 ， 一 方面 是 R 的 高 级 编程 ， 另 一 方面 是 跨 界 知识 的 综合 运用 。 对 于 R 的 高 级 编程 ， 本 书 详细 总 结 了 


R 语 言 的 环境 空间 的 定义 和 使 用 、 文 件 系 统管 理 、 最 新 版 本 R 3.1.1 的 新 特 


性 ， 让 你 体会 R 语 言 的 底层 设计 ; 全 面 介 绍 R 语 言 中 四 种 面向 对 象 体系 的 程序 设计 和 使 用 ， 通 过 面向 对 象 的 程序 设计 ， 让 R 语 言 有 能 力 做 出 符合 现实 世界 的 复杂 应 用 ; 另外 还 介绍 了 完整 的 R 包 开发 流程 ， 并 提 


供 每 日 中 国 天 气 的 应 用 案例 和 游戏 开发 的 案例 ， 帮 助 读者 创建 自己 的 R 包 ， 打 开 R 语 言 产品 化 的 思路 。 


对 于 跨 界 知识 的 综合 运用 ，R 语 言 不 仅 可 以 用 来 非常 方便 地 进行 那些 让 人 头疼 的 数学 计算 ， 无 论 是 初等 数学 或 者 高 等 数学 ， 概 率 或 者 统计 都 可 以 非常 轻松 、 方 便 的 ， 从 此 数学 变 得 不 再 神秘 莫 测 、 遥 不 可 


及 。 用 R 语 言 还 可 以 创建 各 种 模型 ， 书 中 算法 案例 包括 协同 过 滤 算法 模型 、 基 于 矩阵 计算 的 PageRank 模 型 、 金 融 的 交易 策略 模型 和 遗传 算法 的 使 用 。 几 行 代码 几 分 钟 ， 就 可 以 让 我 们 头脑 中 的 想法 变 成 可 运 


行 的 算法 原型 。 


另外 ， 虽 然 R 不 是 特别 适合 开发 游戏 ， 但 如 果真 用 R 语 言 开发 游戏 2048， 也 就 需要 200 行 代码 ， 还 有 哪 种 语言 可 以 匹敌 呢 ? 说 到 这 里 肯定 有 人 问 : “你 为 什么 要 用 R 开 发 游戏 啊 ? ” “为 什么 不 用 Java 


AU?" “我 不 用 R 开 发 ， 用 Java 开 发 不 是 也 一 样 么 ”其实 ， 我 就 是 想 用 这 种 方式 向 大 家 展示 R 语 言 简洁 的 风格 、 自 由 的 思想 、 极 富 想象 的 创造 力 ， 希 望 用 我 这 个 “R 极 客 ” 的 玩 要 心态 ， 引 发 大 家 对 R 的 无 


限 想象 ! 最 后 ， 我 们 把 模型 产品 化 ， 发 布 一 个 属于 自己 的 R 包 ， 让 全 世界 的 人 都 能 使 用 ， 这 是 一 件 多 么 令 人 兴奋 的 事情 。 


在 与 各 界 R 语 言 使 用 者 的 交流 中 ， 我 发 现 ， 有 编程 背景 的 使 用 者 可 以 写 出 干净 漂亮 且 运 行 高 效 的 代码 ， 但 由 于 欠缺 统计 知识 ， 对 模型 优化 就 只 能 束手无策 、 无 可 奈何 了 ;而 那些 具备 统计 背景 的 使 用 者 ， 


虽然 可 以 独立 完成 一 个 模型 的 设计 和 优化 ， 但 对 于 如 何 产品 化 实施 就 完全 找 不 到 办 法 了 。 


本 书 介绍 了 多 个 场景 案例 ， 不 仅 从 学 术 的 角度 完成 了 模型 的 设计 ， 而 且 用 计算 机 的 方法 实现 产品 。 通 过 案例 的 学 习 ， 不 同学 科 背 景 的 R 语 言 使 用 者 可 以 站 在 其 他 人 的 角度 ， 找 到 新 的 思维 方法 。 这 是 本 书 


的 又 一 大 亮点 ! 


对 于 大 多 数 程序 员 来 说 ， 学 习 R 语 言 比较 轻松 容易 ， 但 运用 R 语 言 却 非常 困难 。R 语 言 虽 然 没有 像 C/C++ 一 样 的 复杂 程序 语法 ， 也 不 用 像 Java 一 样 宏观 考虑 全 局 架构 ， 更 没有 JavaScript 一 样 灵活 ,但 


和 


我 认为 ， 学 习 R 语 言 是 为 了 找到 个 性 化 的 自己 ， 定 位 自己 ， 综 合 运用 自身 的 知识 进行 跨 学 科 创 新 ， 而 不 是 去 复制 别人 的 想法 。 


R 语 言 面 向 数据 本 身 的 编程 思想 是 完全 有 别 于 其 他 编程 语言 的 ， 这 就 使 得 很 多 程序 员 在 使 用 R 语 言 时 虽然 理解 语法 ， 但 依旧 不 知道 如 何 应 用 。 


R 语 言 的 跨 界 运用 ， 需 要 你 具备 基础 学 科 (初等 数学 、 高 等 数学 、 线 性 代 


、 概 率 论 、 统 计 学 ) + 业务 知识 金融、 生物 、 互 联网 ) +IT 技 术 〈(R 语 法 、R 包 、 数 据 库 、 算 法 ) 的 综合 能 力 ， 所 以 只 有 提升 


己 的 综合 知识 水 平 ， 才 能 真正 地 学 好 R 语 言 。 换 名 话说， 一 旦 你 学 成 R 语 


D $% 


， 你 将 是 不 可 蔡 代 的 。 


在 此 ， 我 不 得 不 再 次 强调 ， 本 书 不 是 入 门 图 书 ， 而 是 R 语 言 的 高 级 开发 图 书 。 本 书 不 讲 R 的 入 门 语法 ， 也 不 介绍 R 语 言 第 三 方 包 的 使 用 。 但 是 ， 如 果 你 已 经 具备 了 一 定 的 R 语 言 基础 ， 想 把 自己 的 R 语 言 模 


型 产品 化 ， 那 么 我 将 告诉 你 如 何 提高 程序 的 可 靠 性 和 可 扩展 性 ， 以 及 如 何 发 布 属于 自己 的 R 包 。 


本 书 是 “R 的 极 客 理想 ”系列 图 书 的 第 二 本 ， 第 三 本 《R 的 极 客 理想 一 一 量化 投资 篇 》 将 介绍 Ri 语言 在 金融 领域 的 应 用 ， 通 过 R 语 言 构建 交易 模型 ， 并 实现 自动 化 交易 的 过 程 ， 真 正 地 让 技术 人 员 把 自己 的 


知识 变 成 价值 。 


本 书 的 使 用 环境 包括 Linux Ubuntu 和 Windows 7 两 种 操作 系统 ， 在 每 一 节 中 都 有 明确 的 标识 ， 所 有 的 程序 都 是 在 R 语 言 3.1.1 版 本 中 测试 通过 的 。 


R 语 言 还 在 不 断 地 进步 ， 它 将 引导 一 场 数据 的 革命 ， 跨 学 科 的 结合 是 时 代 趋势 ， 也 是 我 们 的 机 遇 ! 


读者 对 象 
本 书 适合 以 下 所 有 R 语 言 工作 者 : 
“ 计算 机 背景 的 软件 工程 师 ; 
“ 有 语言 的 高 级 使 用 者 ; 
“ 数据 分 析 背 景 的 数据 科学 家 ; 
“ 统计 背景 的 科研 工作 者 ; 


“ 开设 相关 课程 的 院 校 学 生 。 


如 何 阅读 本 书 


本 书 的 内 容 分 为 三 个 部 分 。 第 一 部 分 是 R 的 计算 和 算法 应 用 (第 1~2 章 ) ， 介 绍 了 R 语 言 的 知识 体系 结构 ，R 语 言 对 基础 学 科 的 支持 ， 以 及 通过 基础 学 科 实现 各 种 算法 ， 可 帮助 读者 快速 了 解 R 语 言 中 的 数 
学 计算 方法 和 自 定 义 模型 算法 开发 。 


第 二 部 分 是 深入 R 语 言 程序 开发 (第 3~4 章 ) ， 介 绍 了 R 语 言 内 核 相 关 的 编程 ， 包 括 环境 空间 的 定义 和 使 用 ， 以 及 面向 对 象 方法 的 程序 设计 和 使 用 ， 可 帮助 读者 深入 了 解 R 语 言 的 底层 知识 ， 用 面向 对 象 
的 方法 设计 复杂 的 程序 结构 。 


三 部 分 是 开发 自己 的 R 包 (第 5~6 章 ) ， 介 绍 了 R 包 开发 的 完整 流程 ， 并 提供 每 日 中 国 天 气 的 应 用 案例 和 游戏 开发 的 案例 ， 可 帮助 读者 创建 自己 的 R 包 ， 打 开 R 语 言 产 品 化 的 思路 。 


本 书 有 很 多 综合 运用 的 知识 ， 在 阅读 本 书 的 时 候 ， 建 议 读者 顺序 阅读 全 部 的 章节 。 


勘误 和 支持 


由 于 笔者 的 水 平 有 限 ， 加 之 编写 时 间 仓 促 ， 书 中 难免 会 出 现 一 些 错误 或 者 不 准确 的 地 方 ， 奶 请 读者 批评 指正 。 为 此 ， 笔 者 创建 了 一 个 在 线 的 图 书 交 流 网 站 (http://onbook.me) ， 方 便 与 读者 进行 沟 
通 。 如 果 读 者 在 阅读 过 程 中 遇 到 问题 ， 也 可 以 在 官方 网 站 中 留言 ， 我 将 尽量 在 线 上 为 你 提供 最 满意 的 解答 。 书 中 的 全 部 源 代码 ， 都 可 以 从 华章 公司 网 站 (www.hzbook.com) 或 本 书 交流 网 站 下 载 ， 我 也 会 
及 时 更 新 代码 。 如 果 你 有 什么 宝贵 意见 ， 欢 迎 发 送 邮 件 至 bsspirit@gmail.com， 期 待 能 够 得 到 你 真挚 的 反馈 。 


致谢 


感谢 我 的 创业 团队 成 员 林 伟 林 和 林 伟 平 ， 是 R 语 言 让 我 们 走 在 了 一 起 。 感 谢 机 械 工业 出 版 社 华章 公司 的 编辑 明永 玲 ， 帮 助 我 审阅 全 部 章节 ， 引 导 我 顺利 完成 书稿 。 感 谢 我 的 爸爸 、 妈 妈 和 爱人 ， 感 谢 你 们 
对 我 工作 上 的 支持 和 生活 上 的 照顾 ! 


谨 以 此 书 献 给 我 最 亲爱 的 家 人 以 及 众多 R 语 言 爱 好 者 们 ! 
张 丹 
2014 年 11 月 于 中 国 北京 


第 一 部 分 R 的 计算 和 算法 应 用 


me 第 1 章 。R 语 言 知识 体系 和 数学 函数 


me 第 2 章 。R 语 言 的 算法 实现 


第 1 章 。R 语 言 知识 体系 和 数学 函数 


本 章 为 全 书 开篇 ， 主 要 介绍 了 R 语 言 知识 体系 结构 及 学 习 资 料 。 利 用 R 语 言 实现 数 学 计算 和 统计 计算 以 及 连续 型 分 布 函数 的 可 视 化 ， 可 帮助 读者 全 面 理解 R 语 言 ， 并 利用 R 语 言 快 速 地 处 理 基础 学 科 的 计算 
问题 。 


1.1 ”R 语 言 知识 体系 概览 
问题 


如 何 高 效 地 学 习 有 语言 ? 


— " 


R 语 言 知 识 体 系 概览 — 


http://blog.fens.me/r-overview/ 


最 近 遇 到 很 多 想 转行 做 数据 分 析 的 程序 员 ， 他 们 刚 开 始 学 习 R 语 言 。 很 多 人 以 为 有 了 其 他 语言 的 编程 背景 ， 学 习 R 语 言 就 是 一 件 很 简单 的 事情 ， 因 而 一 味 地 追求 速度 ， 但 不 求 甚 解 。 有 人 说 2 周 就 能 掌握 R 


语言 ， 但 其 实 掌握 的 仅仅 是 R 语 言 的 语法 ， 只 能 算是 入 门 。 


RR 语言 的 知识 体系 并 非 语法 这 么 简单 ， 如 果 都 不 了 解 R 的 全 貌 ， 何 谈 学 好 RR 语言 呢 ? 本 节 将 介绍 R 语 言 的 知识 体系 结构 ， 并 告诉 读者 如 何 才能 高 效 地 学 习 R 语 言 。 


1.1.1 ”R 语 言 的 知识 体系 结构 


R 语 言 是 一 门 统计 语言 ， 主 要 用 于 数学 建 模 、 统 计 计 算 、 数 据 处 理 、 可 视 化 等 几 个 方向 ，R 语 言 天 生 就 不 同 于 其 他 的 编程 语言 。R 语 言 封 装 了 各 种 基础 学 科 的 计算 函数 ， 我 们 在 R 语 言 编程 的 过 程 中 只 需 
调用 这 些 计算 函数 ， 就 可 以 构建 出 面向 不 同 领域 、 不 同业 务 的 、 复 杂 的 数学 模型 。 掌 握 R 语 言 的 语法 ， 仅 仅 是 学 习 R 语 言 的 第 一 步 ， 要 学 好 R 语 言 ， 需 要 你 要 具备 基础 学 科 能 力 (初等 数学 、 高 等 数学 、 线 性 
代数 、 离 散 数 学 、 概 率 论 、 统 计 学 ) + 业务 知识 (金融 、 生 物 、 互 联网 ) +IT 技 术 (R 语 法 、R 包 、 数 据 库 、 算 法 ) 的 结合 。 所 以 只 有 把 自己 的 综合 知识 水 平 提升 ， 才 真正 地 学 好 R 语 言 。 换 句 话说 ， 一 旦 你 学 
成 了 R 语 言 ， 你 将 是 不 可 被 替代 的 。 


1.R 语 言 的 知识 体系 结构 概览 


R 语 言 的 知识 体系 结构 是 复杂 的 ， 要 想 学 好 R 语 言 ， 就 必须 把 多 学 科 的 知识 综合 运用 ， 所 以 最 大 的 难点 不 在 于 语言 本 身 ， 而 在 于 使 用 者 的 知识 基础 和 综合 运用 多 学 科 知识 的 能 力 。 


首先 ， 让 我 们 从 宏观 上 来 看 R 语 言 的 知识 体系 结构 的 全 狐 ， 如 图 1-1 所 示 ， 然 后 再 分 别 解释 每 部 分 的 细节 。 


R 语言 的 知识 体系 结构 概览 


电子 商务 、 社 交 网 络 、 了 所 搜索 引擎 、 推 荐 系统 、 决 策 支 
CRM, OA, .新 闻 系统 、 j 持 系 统 、 人 工 智能 系统 、 金融 


1-1 有 语言 的 知识 体系 结构 概览 


图 1-1 中 我 将 R 语 言 知 识 体系 结构 分 为 3 个 部 分 : IT 技术 + 业务 知识 + 基础 学 科 。 这 仅仅 是 我 对 R 语 言 的 理解 ， 不 排除 由 于 个 人 阅历 有 限 导 致 观点 片面 的 问题 。 


IT 技术 是 计算 时 代 必 备 的 技术 之 一 ，R 语 言 就 是 一 种 我 们 应 该 要 掌握 的 技术 。 


业务 知识 是 市 场 经 验 和 法 则 ， 不 管 你 在 什么 公司 ， 都 会 有 自己 的 产品 、 销 售 、 市 场 等 ， 你 要 了 解 你 的 公司 有 什么 产品 ， 客 户 是 谁 ， 怎 么 才能 把 产品 卖 给 你 的 客户 。 


z 
fi 


基础 学 科 是 我 们 这 十 几 年 在 学 校 学 的 理论 知识 ， 当 初学 的 时 候 并 不 知道 是 为 了 什么 ， 毕 业 后 如 果 你 还 能 掌握 一 些 知识 并 实际 运用 ， 那 么 这 将 是 你 最 有 价值 的 竞争 力 。 


每 个 部 分 的 知识 单独 看 都 有 其 局 限 性 ， 但 如 果 能 把 知识 两 两 结合 起 来 ， 就 构成 了 我 们 现在 的 各 种 技术 的 创新 点 。 


IT 技术 + 业务 知识 : 创造 了 阿里 巴巴 的 电子 商务 帝国 ， 还 有 腾讯 全 生态 链 的 社交 网 络 。 


HI 


IT 技术 + 基础 学 科 : 创造 了 Google 搜 索 的 神话 ， 还 有 华尔街 金融 不 败 的 帝国 。 


H 


当然 ，R 语 言 只 是 一 门 计算 机 语言 技术 ， 不 能 独自 承担 改写 历史 的 重任 ,但 R 语 言 确实 给 了 我 们 很 大 的 想象 空间 ， 让 我 们 能 动手 去 了 解 这 个 世界 的 规律 ， 找 到 无 穷 无 尽 的 交叉 点 ， 创 造 出 新 的 帝国 。 


如 果 你 和 我 一 样 ， 都 能 站 在 这 个 角度 来 学 习 和 使 用 R 语 言 ， 那 么 我 们 一 定 可 以 成 为 并 肩 向 前 的 同路人 。 


2.R 语 言 的 基础 知识 


蓝图 总 是 宏大 和 美好 的 ， 但 具体 落实 将 是 困难 重重 的 。 接 下 来 ， 我 将 会 梳理 思路 ， 把 所 有 的 知识 点 对 应 到 可 操作 的 文档 上 ， 希 望 帮助 大 家 掌握 R 语 言 的 全 尧 ! 


R 语 言 的 基础 知识 ， 包 括 R 语 言 的 语法 、R 语 言 核心 包 的 使 用 、R 语 言 的 内 核 编程 、R 语 言 包 的 开发 以 及 R 语 言 的 虚拟 机 。 


(1) R 语 言 的 语法 


语法 是 我 们 了 解 R 语 言 的 第 一 步 ， 和 所 有 人 一 样 ， 我 也 曾 在 很 短 的 时 间 内 就 掌握 了 R 语 言 的 语法 规则 、 数 据 结构 、 基 本 类 型 和 常用 函数 等 ， 但 其 实 R 语 言语 法 上 的 坑 ， 远 比 你 知道 的 多 得 多 。 


我 举 个 例子 ， 看 谁 能 准确 地 回答 。 比 如 ， 最 基础 的 符号 操作 “=”“<-”“<<-”， 三 者 有 什么 区 别 ? 分 别 在 什么 时 候 用 ? 不 要 说 问题 太 偏 了 ， 实 际 根本 用 不 到 。 我 的 代码 里 处 处 都 在 用 这 3 个 符号 ， 只 
是 你 不 知道 而 已 。 在 学 习 R 语 言 的 时 候 ， 不 要 用 已 经 掌握 的 C、Java、Python 的 经 验 直接 去 套 R 语 言 的 语法 ， 掉 坑 里 的 就 是 这 些 人 。 要 从 头 开 始 学 ， 一 路 上 没有 捷径 。 


R 语 言 是 函数 式 语言 ， 语 法 自由 ， 命 名 自由 ， 使 用 简单 ， 这 只 是 对 于 普通 用 户 来 说 的 。 作 为 一 个 有 理想 的 极 客 ， 怎 么 能 只 停留 在 语法 上 呢 ? R 语 言 是 完全 面向 对 象 的 ， 你 了 解 什么 是 面向 对 象 吗 ”Ri 语言 
的 面向 对 象 打 破 了 R 语 言 原 有 的 自由 ,但 又 要 兼容 原 有 的 自由 语法 ， 多 么 纠结 的 设计 啊 ， 你 能 体会 到 吗 ? 并 不 是 记 住 了 R 语 言 的 语法 ， 就 代表 掌握 了 R 语 言 。 里 面 各 种 坑 ， 只 有 自己 踩 了 ， 再 自己 息 出 来 , 才 
是 真正 的 成 长 。 


(2) R 语 言 核心 包 的 使 有 


R 语 言 同 其 他 语言 一 样 ， 在 软件 启动 时 ， 为 我 们 提供 了 7 个 核心 包 ， 其 中 包括 众多 的 


等 。 通 过 search () 函数 ， 可 以 查看 到 R 启 动 时 默认 加 载 7 个 核心 包 。 


> search () + 查看 当前 环境 已 加 载 的 R 包 

[1] ".GlobalEnv" "package: stats" "package: graphics" 
[4] "package: grDevices" "package: utils" "package: datasets" 

[7] "package: methods" "Autoloads" "package: base" 


这 7 个 核心 包 就 是 我 们 构建 复杂 模型 的 基础 。 由 于 这 几 个 核心 包 比较 底 


包 就 是 学 习 的 门槛 。 


> a«-1: 10; a # 赋值 
[112345677 8 910 


答案 是 ，“1: 10” 对 应 “seq () ”，“<-” 对 应 assign () 。 


> assign ('b', seq (1: 10) ) ; b # 通过 函数 赋值 


[ X 23.4.5 € 7.8 9 10 


这 种 对 应 关系 的 意义 在 于 ， 因 为 R 语 言 是 解释 型 语言 ， 我 们 可 以 通过 传递 一 个 函数 A 的 句柄 ， 让 其 他 的 函数 B 动 态 调 


层 ， 很 多 函数 都 是 


础 函数 ， 如 数学 计算 函数 、 统 计 计算 函数 、 


再 问 个 问题 ，R 语 言 的 所 有 操作 都 是 函数 操作 ， 那 么 “a<-1: 10” 语 句 会 被 解析 为 对 应 什么 函数 ? 


经 被 广泛 使 用 了 ， 但 在 R 语 言 中 ， 却 只 有 核心 包 的 一 些 函 数 使 有 


语言 ， 要 多 想 想 如 何 才能 把 其 他 语言 的 基础 带 到 R 语 言 的 世界 里 。 


(3) R 语 言 的 内 核 编程 


R 语 言 的 内 核 编程 又 是 一 个 比较 复杂 的 计算 机 学 科 的 问题 。 


等 。 本 书 将 会 重点 介绍 这 些 内 容 。 


面向 对 象 编程 是 一 种 理解 和 抽象 现实 世界 的 方法 ， 主 要 


期 函数 、 包 加 载 函数 、 数 据 处 理 函 数 、 函 数 操作 函数 和 图 形 设备 函数 


C 语 言 封装 的 ， 没 有 R 语 言 的 源 代码 ， 而 且 除 了 官方 文档 ， 几 乎 没有 其 他 更 详细 的 文档 介绍 ， 所 以 这 几 个 核心 


这 个 函数 A， 这 就 是 动态 语言 中 的 闭 包 特性 的 使 用 思路 。 这 种 思路 在 JavaScript 中 已 
这 种 语法 。 在 R 语 言 中 ， 这 种 需要 有 计算 机 背景 知识 的 地 方 还 有 很 多 ， 特 别 是 在 考虑 如 何 提升 R 语 言 的 性 能 时 。 所 以 ， 不 要 轻易 说 自己 掌握 了 R 


R 语 言 的 内 核 编程 应 该 包括 哪些 内 容 呢 ， 除 了 刚才 说 的 R 语 言 的 语法 和 R 的 核心 包 ， 还 有 面向 对 象 编程 、 向 量化 计算 、 特 殊 数据 类 型 、 环 境 空间 


于 解决 复杂 问题 的 设计 及 实现 。 在 Java 的 世界 里 ， 从 2003 年 我 开始 接触 Java 的 时 候 ， 社 区 就 已 经 在 聊 面向 对 象 的 程序 设计 了 。 对 于 Ri 语言 3 


说 ， 直 到 2011 年 发 布 的 2.12 版 本 ， 才 最 终 有 了 RC 类 型 的 面向 对 象 实现 。 面 向 对 象 的 成 熟 ， 标 志 着 R 语 言 已 经 具备 了 构建 复杂 大 型 应 用 的 能 力 ， 但 如 何 真正 地 把 面向 对 象 用 好 ， 似 乎 也 并 不 是 统计 人 擅长 的 。 


像 Hadley Wickham 那 样 有 能 力 写 出 面向 对 象 代码 的 人 ， 在 R 语 言 的 


子 里 ， 实 在 是 太 少 了 。 


向 量化 计算 是 R 语 言 特 有 的 一 种 并 行 计算 方式 。 在 R 语 言 中 ， 向 量 (vector) 是 R 的 基本 数据 类 型 ， 当 你 对 一 个 向 量 进行 操作 时 ， 程 序 会 对 向 量 中 的 每 个 元 素 分 别 计算 ， 计 算 结果 以 向 量 的 形式 返回 。 比 


如 ， 最 常见 的 两 个 等 长 的 向 量 相 加 。 


» 1: 10H10: 1 # 两 个 向 量 相 加 
[1] 11 11 11 11 11 11 11 11 11 11 


向 量化 计算 ， 在 R 中 有 很 广泛 的 应 用 场景 ， 基 本 可 以 取代 循环 计算 ， 高 效 地 完成 计算 任务 。 我 们 定义 两 个 向 量 ， 先 相 加 再 求 和 ，run1 () 函数 


> a«-1: 100000 
» b«-100000: 1 
> runi«-function () ( 
sum (as.numeric (a+b) ) 
} 
run2<-function () { # 循环 计算 
c2«-0 
for (i in 1: length (a) ) { 
c2«-a[i]*b[i]4c2 


# 向 量化 计算 


} 
c2 
} 


V+ 二 十 十 十 + V+++ 


000 


向 量化 计算 实现 ，run2 () 用 循环 方法 实现 。 


system.time (runl () ) # Hprunl () 函数 的 执行 时 间 用 户 


> system.time (run2 () ) # 统计 run2 () 函数 的 执行 时 间 用 户 


0.14 0.00 0.14 


流逝 


系统 流逝 


通过 运行 程序 ， 我 们 可 以 清楚 地 看 出 ， 向 量化 计算 要 比 循环 快 。 当 算法 越 复杂 数据 量 越 大 的 时 候 ， 计 算 的 时 间 差距 会 越 明显 。R 语 言 的 编程 中 的 一 条 经 验 法 则 就 是 用 向 量 计算 代替 所 有 的 循环 计算 。 


R 语 言 中 除了 那些 基本 的 数据 类 型 ， 还 有 一 些 高 级 的 特殊 数据 类 型 ， 这 些 特殊 数据 类 型 并 不 是 不 常 F 
环境 (environment) 类 型 是 由 内 核定 义 的 一 个 数据 结构 ， 由 一 系列 有 层次 关系 的 框架 (frame) 组 成 ， 每 个 环境 对 应 一 个 框架 ， 用 来 


每 个 环境 空间 都 是 环境 类 型 的 一 个 实例 。 每 个 R 包 都 会 被 加 载 到 一 个 环境 空间 中 ， 形 成 有 


， 而 是 你 不 知道 。S3 类 型 、S4 类 型 、RC 类 型 分 别 对 应 R 语 言 支持 的 三 种 面向 对 象 编程 的 数据 结构 。 


区 别 不 同 的 运行 时 空间 (scope) 。 


层次 关系 的 、 可 调用 的 空间 结构 。 


我 们 定义 的 函数 和 变量 都 会 存在 于 R 语 言 的 环境 空间 中 ， 通 过 ls () 就 可 以 看 到 当前 环境 空间 中 的 这 些 变量 ， 比 如 ， 刚 才 向 量化 计算 定义 的 变量 和 函数 。 


> 1s () # 查看 当前 环境 空间 的 变量 


[1 a "p" "runl" "run2" 


除了 我 们 自己 定义 的 变量 和 函数 之 外 ， 环 境 空间 中 还 有 很 多 其 他 的 变量 和 函数 ， 比 如 sum () . length () . system.time () 等 ， 我 们 可 以 直接 使 


以 直接 用 ls () 是 查看 不 到 的 。 当 切换 到 base 的 环境 空间 时 ， 就 可 以 找到 sum () 的 函数 定义 了 。 


> ls (pattern-"^sum$", envir-baseenv () ) # 查看 base 环 境 空间 的 变量 

[1] "sum" 

R 语 言 的 内 核 编程 ， 如 同 其 他 语言 一 样 ， 包 括 很 多 的 知识 细节 ， 并 不 是 只 有 我 提 到 的 这 几 点 。 但 由 了 
发 现 更 多 的 秘密 。 


(4) R 语 言 包 的 开发 


这 些 函 数 ， 但 是 它们 并 不 在 当前 环境 空间 中 ， 所 


FF 缺少 文档 ， 同 时 R 核 心 技术 不 普及 ， 所 以 知道 的 人 不 多 ， 会 用 的 人 就 更 少 。 笔 者 也 在 每 天 探索 ， 期 待 


R 语 言 包 的 开发 是 R 语 言 编程 中 比较 困难 但 又 不 得 不 面 对 的 问题 ， 不 仅 要 把 上 文中 所 提 到 的 各 种 R 语 言 技术 综合 运用 在 一 起 ， 还 要 符合 R 语 言 包 的 开发 规范 ， 并 用 Latex 写 好 文档 ， 最 后 提交 给 CRAN 发 
布 。 技 术 问题 虽然 难 ， 花 时 间 还 是 可 以 解决 的 ， 但 想 要 在 CRAN 上 发 布 ， 那 就 只 能 


gridgame 游 戏 包 和 chinaWeather 天 气 包 ， 改 了 很 多 次 都 没 能 


换个 角度 想 ， 只 有 审核 严格 才能 保证 用 户 在 安装 第 三 方 R 语 言 包 的 时 候 不 会 出 错 。 由 


通过 ， 都 快 到 要 放弃 


的 边缘 了 。 


上 青天 ”来 形容 了 。 R 语 言 发 展 了 20 多 年 ， 只 有 5000 多 个 包 在 C 


RAN 上 发 布 ， 审 核 不 是 一 般 严 格 啊 ! 我 写 的 


CRAN 的 


核 过 于 严格 ，Hadley Wickham 也 受 不 了 了 ， 他 又 


发 了 devtools 包 ， 不 仅 提 供 了 简化 R 语 言 包 的 开发 


的 工具 函数 ， 还 支持 Github 社 区 发 布 。 这 样 就 可 以 脱离 CRAN 的 束缚 ， 以 个 人 的 名 义 发 布 各 种 奇 思 妙 想 的 R 语 言 包 ， 甚 至 是 “不 误 正业 ”的 R 语 言 包 。 


(5) R 语 言 的 虚拟 机 


终于 该 说 我 不 熟悉 的 话题 了 ， 从 我 3 年 多 的 R 语 言 使 用 经 验 来 说 ， 还 碰 不 到 R 语 言 的 虚拟 机 。 不 过 ， 网 上 看 到 很 多 高 手 在 生产 环境 都 会 重新 编译 R 软 件 ， 比 如 用 OpenBLAS 加 速 R 的 矩 阵 运 算 ， 在 虚拟 机 层 
实现 矩阵 的 并 行 化 计算 ， 也 有 用 GPU 实现 矩阵 并 行 计算 的 ; 还 有 牛人 把 R 实 现 的 各 种 算法 都 用 C+ + 重新 实现 ， 然 后 通过 Rcpp 封 装 ， 直 接 与 R 语 言 的 虚拟 机 进行 连接 调用 。 


G 


3.R 语 言 的 第 三 方 包 


R 语 言 的 第 三 方 包 ， 主 要 包括 在 CRAN 上 的 5000 多 个 第 三 方 包 ， 以 及 其 他 社区 中 的 R 语 言 包 ， 这 些 包 在 各 种 领域 中 都 发 挥 着 重要 的 作用 。 在 《R 的 极 客 理想 一 一 工具 篇 》 一 书 中 ， 我 介绍 了 30 多 个 包 的 使 
， 包 括 基础 工具 包 (fortunes，formatR，rjson，RJSONIO，Cairo，CaTools) 、 时 间 序 列 包 (zoo, xts, xtsExtra) 、 性 能 监控 包 (memoise, profr, lineprof) 、R 跨 平台 通信 和 包 
(Rserve, Rsession, rJava) 、R 服 务 器 包 (Rserve, RSclient, FastRWeb, Websocket) 、 数 据 库 访 问 包 (RMySQL，rmongodb，rredis，RCassandra，RHive) ，Hadoop 操 作 包 
(rhdfs，rmr2，rhbase) 等 。 


还 有 很 多 常用 的 包 ， 比 如 数据 处 理 包 (lubridate, plyr, reshape2, stringr, formatR, mcmc) 、 机 器 学 习 包 (nnet, rpart, tree, party, lars, boost, e1071, BayesTree, gafit, arules) 、 
可 视 化 包 (ggplot2, lattice, googleVis) 、 地 图 包 (ggmap, RgoogleMaps, rworldmap) 等 。 


R 语 言 对 于 金融 也 有 很 好 的 支持 ， 有 时 间 序 列 包 (zoo, xts, chron, its, timeDate) 、 人 金融 分 析 包 
(quantmod, RQuantLib, portfolio, quantstrat, blotter, PerformanceAnalytics, TTR, sde, YieldCurve) 、 风 险 管理 包 (parma, evd, evdbayes, evir, extRemes, ismev) 等 。 同 时 ,笔者 
正在 量化 投资 的 创业 中 ，R 语 言 作为 系统 架构 中 的 算法 引擎 是 在 最 核心 的 位 置 ，R 语 言 正 用 在 最 有 价值 的 业务 中 ， 在 后 续 的 《R 的 极 客 理 想 一 一 量化 投资 篇 》 一 书 中 ， 我 将 会 完整 地 介绍 R 语 言 在 量化 投资 系统 
中 的 运用 。 


4 数学 的 基础 知识 


数学 的 基础 知识 主要 包括 初等 数学 、 高 等 数学 、 线 性 代数 、 概 率 论 、 统 计 学 等 。 我 们 在 大 学 中 曾经 学 过 的 各 种 数学 ， 那 些 不 知道 有 什么 用 ， 只 为 考试 而 学 的 数学 ， 是 能 真正 决定 R 语 言 掌握 深度 的 基础 知 


当 R 语 言 普及 、 变 成 大 众 化 的 编程 语言 以 后 ， 入 门 会 越 来 越 容 易 ， 第 三 方 包 的 调用 会 越 来 越 简单 ， 最 后 就 是 拼 基 础 学 科 功底 了 ， 数 学 就 是 对 所 有 人 来 说 最 难 的 基础 学 科 。 


初等 数学 ， 咱 们 中 国人 一 直 都 在 强调 数学 是 我 们 的 优势 ， 其 实 强 的 部 分 仅 限于 初等 数学 ， 加 法 口 决 和 乘法 口 决 让 我 们 可 以 口算 100 以 内 的 四 则 运算 。 


高 等 数学 ， 可 能 是 大 学 里 挂 科 最 多 的 一 门 课 ， 很 多 老师 照 本 宣 科 让 很 多 学 生 完全 不 知 所 云 。 直 型 


遇 到 R， 我 才 忧 悟 为 什么 最 小 二 乘法 能 进行 最 优化 的 计算 。 重 新 捡 起 高 数 是 学 R 的 必 经 之 路 。 


线性 代数 ， 直 到 读 完 Google 的 PageRank 论 文 的 N 年 后 ， 我 自己 才 想 明 白 ， 原 来 矩阵 可 以 处 理 海量 数据 的 计算 ， 实 现 分 步 式 算法 与 单机 算法 的 一 致 性 。 


概率 论 ， 通 过 R 语 言 进行 各 种 分 步 的 随机 实验 ， 并 把 概率 密度 函数 曲线 应 用 到 实际 的 业务 中 ， 才 让 我 们 理解 概率 才 是 可 以 衡量 客观 事件 发 生 的 指标 。 


统计 学 ， 通 过 R 语 言 我 们 可 以 很 简单 地 构建 各 种 统计 模型 ， 利 用 Bayes 分 类 器 判断 垃圾 邮件 ， 利 用 回归 模型 预测 未 来 的 房价 。 


是 R 语 言 能 让 我 切身 地 感受 到 ， 数 学 的 基础 知识 在 我 们 实际 生活 中 的 运用 ; 也 是 R 语 言 拉 近 了 学 术 界 和 工业 界 的 距离 。 如 果 能 把 我 们 从 小 到 大 学 到 的 知识 串 起 来 ， 我 想 每 个 人 都 会 具备 与 众 不 同 的 知识 结 
构 ， 将 会 在 各 行 各 业 实现 伟大 的 创新 。 


5. 业 务 知识 


业务 知识 涉及 的 面 非常 广 ， 每 个 人 都 可 以 利用 自身 所 处 行业 的 知识 ， 并 结合 R 语 言 擅长 的 领域 ， 发 现 新 的 机 会 。R 语 言 擅长 的 领域 包括 统计 分 析 、 金 融 分 析 、 数 据 挖掘 、 互 联网 、 生 物 信息 学 、 生 物 制 
药 、 全 球 地 理科 学 、 数 据 可 视 化 等 。 


我 在 软件 和 互联 网 行业 待 了 10 年 ， 亲 身 经 历 了 两 个 行业 的 高 速 发 展 和 和 变迁。 技术 一 波 又 一 波 ， 每 年 都 有 新 的 主题 ， 一 路 跟 下 来 的 人 越 来 越 少 ， 虽 然 新 鲜 的 血液 不 断 补充 着 ， 但 这 些 “ 血 液 ” 的 能 力 和 经 
给 却 远 达 不 到 要 求 ， 被 市 场 的 浮躁 扰动 着 。 近 些 年 ， 中 国 的 创业 公司 的 成 功 ， 少 有 技术 创新 ， 大 都 是 商业 模式 创新 和 资本 运作 的 成 功 。 


面 对 着 中 国资 本 市 场 ， 掌 握 好 业务 方面 的 知识 ， 就 是 找到 了 赚钱 的 法 宝 。 当 业务 成 熟 ， 在 大 家 都 懂得 游戏 规则 后 ， 竞 争 就 会 变 得 异常 激烈 了 ， 像 电 商 、 团 购 、 旅 游 、 酒 店 、 游 戏 都 是 如 此 。 新 领域 新 业 
务 ， 才 是 值得 80 后 90 后 年 轻 人 奋斗 的 方向 。 如 火 如 茶 的 O20O、 互 联网 金融 、 物 联网 、 机 器 人 ， 也 许 正 是 2015 年 的 爆发 点 。 如 果 你 又 懂 技 术 又 懂 业 务 ， 学 习 能 力 又 强 ， 你 将 是 下 一 个 帝国 的 创造 者 。 


6. 跨 学 科 的 综合 运用 能 力 


次 强调 ， 只 要 把 多 种 学 科 知识 综合 运用 ， 不 仅 能 够 成 为 R 语 言 的 一 代 高 手 ， 更 能 够 实现 自我 的 价值 。 


当 IT 技 术 与 业务 知识 完美 结合 ， 你 会 在 新 兴 的 市 场 找到 机 会 。 一 旦 市 场 成 熟 后 ， 业 务 竞争 就 会 变 成 资本 竞争 ， 机 会 将 不 复 存 在 。 


当 IT 技 术 与 基础 学 科 相 结合 ， 你 可 以 通过 科技 创新 ， 建 立 技术 壁垒 ， 保 持 技术 优势 直到 成 为 行业 老大 。 


如 果 IT 技 术 、 业 务 知识 、 基 础 学 科 三 者 同时 具备 ， 那 么 你 将 是 不 可 被 替代 的 。 只 要 找到 属于 你 的 团队 ， 研 发 出 自己 的 产品 ， 推 广 给 你 的 用 户 ， 你 就 已 经 成 功 了 ! 


R 语 言 可 以 从 IT 的 角度 帮助 你 实现 成 功 ， 同 时 你 的 成 功 也 将 是 R 语 言 的 成 功 ! 


1.1.2. R 语 言 学 习 


花 了 很 大 的 篇 幅 ， 终 于 把 我 理解 的 R 语 言 的 知识 体系 解释 清楚 了 。 那 么 接 下 来 ， 我 们 应 该 如 何 高 效 地 学 习 R 语 言 呢 ?” 有 和 句 话 要 说 在 前 头 ， 学 习 是 艰苦 的 ， 没 有 捷径 可 言 ， 如 果 你 想 成 功 ， 那 么 更 要 面 对 苦 
中 之 苦 。 正 确 的 学 习 方法 ， 可 以 让 我 们 少 走 弯 路 ， 学 习 别人 的 经 验 ， 会 让 我 们 加 速成 长 。 


通过 上 文中 对 跨 学 科 知 识 体系 的 描述 ， 我 想 大 家 都 应 该 明白 了 ， 要 想 学 好 R 语 言 ， 最 大 的 难点 不 在 于 语言 本 身 ， 而 在 于 使 
为 前 提 的 ， 先 抛 开 业务 知识 和 基础 学 科 的 知识 不 说 ， 只 谈 IT 技术 ， 应 该 要 掌握 哪些 知识 呢 ? 


者 的 知识 基础 和 综合 运用 知识 的 能 力 。 当 然 ， 综 合 运 用 是 要 以 良好 的 基础 知识 


1.1T 基 础 知识 


对 于 R 语 言 本 身 来 说 ， 我 们 需要 掌握 R 语 言 的 基础 知识 ， 包 括 R 的 语法 、R 核 心包 的 使 用 、R 语 言 的 内 核 编 程 、R 语 言 包 的 开发 以 及 与 业务 相关 的 第 三 方 R 语 言 包 的 使 用 。 


如 果 你 在 学 习 R 语 言 之 前 ， 已 经 有 了 很 多 的 Java、Python 等 编程 语言 的 经 验 ， 那 么 这 将 帮助 你 很 快 熟 悉 R 语 言 ， 你 只 要 再 补充 一 些 数据 分 析 和 数据 挖掘 算法 的 知识 ， 就 能 马上 将 R 语 言 用 在 实际 的 工作 中 
了 。 


如 果 你 之 前 是 SAS 或 Matlab 数 据 科 学 家 ， 那 你 只 需要 熟悉 R 语 言 的 编程 语法 和 第 三 方 R 语 言 包 ， 就 能 用 R 语 言 来 完成 SAS 和 Matlab 的 所 有 任务 。 


如 果 你 是 Bl 程序 员 ， 平 时 工作 经 常 有 处 理 数据 和 可 视 化 的 任务 ， 那 么 你 可 以 边 学习 R 语 言 边 补充 一 些 统计 方面 的 知识 ， 从 无 味 的 ETL 过 程 中 发 现 数据 的 价值 。[] 


如 果 你 是 一 名 在 读 的 统计 学 专业 学 生 ，R 语 言 将 帮助 你 把 书本 上 枯燥 的 知识 程序 化 ， 让 你 在 学 习 过 程 中 发 现 社会 的 规律 。 


如 果 你 一 直 在 用 Excel 并 抱怨 其 功能 远 远 不 够 ， 请 试 一 下 R 语 言 ， 你 的 想法 很 快 就 会 变 成 你 财富 的 源泉 。 


如 果 你 是 一 名 宽 客 (Quant) ， 还 不 懂 R 语 言 的 话 ， 那 么 你 很 快 就 会 被 市 场 淘汰 。 


如 果 你 是 一 名 Hadoop 算 法 工程 师 ， 用 Java 写 一 个 MR 算法 通常 要 好 几 干 行 ， 你 可 试 试用 RHadoop,， 十 分 之 一 的 代码 行 就 可 以 完成 同样 的 事情 。 


还 有 很 多 可 举例 说 明 的 故事 。R 语 言 可 以 与 各 种 技术 、 各 种 思路 相 结 合 ， 让 R 语 言 和 你 已 掌握 的 知识 进行 碰撞 ， 你 就 会 变 得 和 别人 不 一 样 。 


2.R 语 言 中 文 图 书 


邓 一 硕 (博客 http://yishuo.org) 曾经 写 过 一 篇 名 为 《R 语 言 书籍 的 学 习 路 线 图 书 》 的 博文 ， 这 篇 文章 很 有 参考 意义 。 文 章 分 别 介绍 了 R 语 言 的 初级 入 门 、 高 级 入 门 、 绘 图 与 可 视 化 、 计 量 经 济 学 、 时 间 
序列 分 析 和 金融 等 内 容 ， 涉 及 30 多 本 R 语 言 图 书 和 小 册子 ， 但 大 部 分 是 英文 的 。 


随 着 时 间 的 推移 ， 这 两 年 R 语 言 方面 又 增加 了 好 多 本 新 书 ， 中 文 图 书 也 慢 慢 地 多 了 起 来 。 我 重新 定义 的 R 语 言 中 文 图 书 学 习 路 线 图 ， 如 图 1-2 所 示 。 


统计 建 模 与 R 软 件 


时 间 序 列 分 析 及 应 用 
人 语言 ) 原 书 第 2 版 


R 的 极 客 理 想 
高 级 开发 篇 


图 1-2 R 语 言 中 文 图 书 学 习 路 线 图 


对 于 不 同 层次 的 R 语 言 用 户 ， 也 有 了 市 场 细 分 。 入 门 的 朋友 可 以 从 《R 语 言 编程 艺术 》 开 始 学 习 ; 有 一 定 R 语 言 基 础 的 朋友 可 以 阅读 《R 语 言 实战 》， 需 要 扩展 知识 面 的 朋友 可 以 阅读 《R 的 极 客 理想 一 一 
工具 篇 》; 在 掌握 了 R 语 言 的 各 种 入 门 技术 后 ， 高 级 的 R 语 言 开发 者 可 以 阅读 本 ; 用 R 做 可 视 化 的 朋友 ， 可 以 阅读 《ggplot2: 数据 分 析 与 图 形 艺 术 》; 正在 学 习 统计 学 的 朋友 ， 可 以 阅读 《统计 建 模 与 R 软 
件 》; 准备 用 R 做 金融 的 朋友 ， 可 以 阅读 《时 间 序 列 分 析 及 应 用 : RES ( 原 书 第 2 版 ) 》 和 《人 金融 数据 分 析 导论 : 基于 R 语 言 》。 


以 上 推荐 的 图 书 ， 我 都 亲自 读 过 ， 予 以 品质 保证 。 此 图 书 列表 将 在 我 的 博客 中 不 定期 更 新 ， 把 我 读 到 的 好 书 分 享 给 大 家 ! 


xl 


3.R 语 言 中 文 社区 


除了 图 书 ， 中 文 的 R 语 言 社区 和 个 人 博客 也 在 蓬勃 发 展 。 统 计 之 都 是 中 国 大 陆 最 权威 的 R 语 言 组 织 ， 其 中 不 仅 积累 了 大 量 高 质量 的 R 语 言 文章 ， 并 主办 了 七 届 中 国 R 语 言 会 议 。 统 计 之 都 团队 成 员 ， 还 参与 
翻译 了 《R 语 言 编程 艺术 》《R 语 言 实战 》《ggplot2: 数据 分 析 与 图 形 艺术 》《R 语 言 核心 技术 手册 (第 2 版 ) 》《R 数 据 可 视 化 手册 》《R 语 言 统计 入 门 (第 2 版 )》 等 多 本 图 书 。 


炼 数 成 金 论 坛 ， 以 数据 分 析 为 主题 ， 设 有 R 语 言 板 块 ， 提 供 在 线 的 R 语 言 入 门 培训 ， 黄 志 洪 老师 的 算法 讲解 超一流 。 


人 大 经 济 论坛 ， 以 经 管教 育 为 主题 ， 设 有 R 语 言 板块 ， 以 线 下 培训 为 主 。 


4.R 语 言 中 文博 客 
笔者 的 个 人 博客 一 一 粉丝 日 志 (http://blog.fens.me) ,原创 了 大 量 的 R 语 言 技术 实战 文章 ， 包 括 R 的 极 客 理想 系列 文章 、RHadoop 实 践 系列 文章 、R 利 剑 NoSQL 系 列 文章 ， 并 写作 “R 的 极 客 理想 ” 系 
列 图 书 。 


谢 益 辉 的 个 人 博客 (http://yihui.name) ， 博 客 中 主要 包括 各 种 有 趣 的 技术 和 吐槽 文章 。 谢 益 辉 是 统计 之 都 的 创始 人 ， 现 任 RStudio 公 司 程序 员 。 


刘 思 荫 的 个 人 博客 一 一 贝 吉 塔 行星 (http://www.bjt.name) ， 博 客 中 主要 包括 R 语 言 企业 级 应 用 的 文章 。 刘 思 芋 现任 京东 推荐 算法 经 理 。 


李 舰 的 个 人 博客 (http;//Jliblog.com) ， 博 客 中 主要 包括 R 语 言 建 模 的 文章 。 李 舰 现 任 Mango Solutions 中 国 区 数据 总 监 。 
邓 一 硕 的 个 人 博客 一 一 格物 堂 (http://yishuo.org) ， 博 客 中 主要 包括 R 语 言 金融 数据 分 析 的 文章 。 


不 周 山 (http://www.wentrue.net/blog) ， 博 客 中 主要 包括 R 语 言 并 行 技术 的 文章 。 


阿 稳 的 个 人 博客 


最 后 ， 祝 大 家 把 R 语 言 学 好 用 好 ， 在 各 自 的 领域 中 找到 创新 的 突破 口 ， 实 现 自我 价值 ， 然 后 反馈 给 R 语 言 社区 ， 加 速 R 语 言 的 发 展 壮大 。 


1] ETL 即 数据 抽取 (Extract) 、 转 换 (Transform) . KA (Load) 的 过 程 。 


如 何 用 有 语言 进行 数学 计算 ? 


(2^cos(a*b))*exp((a-log2(b))/sqrt(b)) 


complex choose 


R 语 言 中 的 数学 计算 


http://blog.fens.me/r-mathematics/ 


R 语 言 是 统计 语言 ， 生 来 就 对 数学 有 良好 的 支持 ， 用 R 语 言 做 数学 的 计算 题 特别 方便 。 如 果 计 算 器 中 能 府 入 R 语 言 的 计算 函数 ， 那 么 绝对 是 一 种 高 科技 产品 。 我 真 的 把 R 语 言 当成 我 的 计算 器 了 ! 


im 
R 


R 语 言 对 数学 计算 有 着 非常 好 的 支持 ， 本 节 将 完整 介绍 初等 数学 中 的 各 种 计算 操作 。 
本 节 的 系统 环境 是 : 
* Windows 7 64bit 


“ R: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 


R 语 言 实现 四 则 运算 操作 ， 包 括 加 、 减 、 乘 、 除 、 余 数 、 整 除 、 绝 对 值 、 判 断 正 负 。 


> a<-10; b<-5 # 定义 2 个 变量 
> a+b; a-b; a*b; a/b # 加 减 乘除 
1] 15 

1] 5 

1] 50 

1]2 

> a$$b; a$/*b # 余数 ， 整 除 
1] 

1] 2 

» abs (-a) # 绝对 值 
1] 10 

> sign (-2: 3) # 判断 正 负 


1] 1-1 Q9 1 i1 1 


RESSAIRE OER BAEAN, FIIR 


> a<-10; b<-5; c<-4 # 定义 3 个 变量 
> c^b; c^-b; c^ (b/10) LEE SCR 

1] 1024 

1] 0.0009765625 

1] 2 

» exp (1) + 取 自然 常数 e 

1] 2.718282 

> exp (3) + 自然 常数 e 的 容 
1] 20.08554 


> sqrt (c) AGER 


1] 2 


» log2 (c) d 以 2 为 底 的 对 数 
1]2 

> log10 (b) # 以 10 为 底 的 对 数 
1] 0.69897 

> log (c, base = 2) + 自 定义 底 的 对 数 
1]2 

> log (a, base-exp (1) ) # 自然 常数 e 的 对 数 
1] 2.302585 

> log (a^b, base-a) # 指数 对 数 操作 
1] 5 

» log (exp (3) ) 

1] 3 


用 R 语 言 实现 比较 计算 操作 ,包括 ==、>、<、! =, <=, >=, isTRUE, identical, 


> a<-10; b<-5 # 定义 2 个 变量 

> a--a; a! =b; a»b; a<b; a<=b; a»-c # 比较 计算 
TRUE 

TRUE 

TRUE 

FALSE 

FALSE 

TRUE 

> isTRUE (a) * 判断 是 否 为 TRUE 

1] FALSE 

» isTRUE (! a) 

1] FALSE 

» identical (1, as.integer (1) ) # 精确 比较 两 个 对 象 
1] FALSE 

> identical (NaN, -NaN) 

1] TRUE 

> f <- function (x) x 

> g <- compiler: : cmpfun (f) 

> identical (f, g) 

1] TRUE 


用 R 语 言 实现 逻辑 计算 操作 ， 包 括 &、|、&&、||、xor。 


> # 定义 2 个 向 量 

> y«-c (0, 0, 1, 1) 

»x&&y x |l y # 只 比较 向 量 的 第 一 个 元 素 &&, I 

1] FALSE 

1] FALSE 

2»x&y;xly # S4 对 象 的 逻辑 运算 ， 比 较 所 有 元 素 &， | 
1] FALSE FALSE FALSE TRUE 

1] FALSE TRUE TRUE TRUE 


» xor (x, y) + 异 或 比较 
1] FALSE TRUE TRUE FALSE 

> xor (x, ! y) 

1] TRUE FALSE FALSE TRUE 


用 R 语 言 实现 约 数 计算 操作 ， 包 括 ceiling、floor、trunc、round、signif。 


> ceiling (5.4) + 向 上 取 整 

划 6 

> floor (5.8) # 向 下 取 整 

1] 5 

> trunc (3.9) # 取 整 数 

1] 3 

> round (5.8) # 四 全 五 入 

1] 6 

» round (5.8833, 2) # 四 舍 五 入 ， 并 保留 2 位 小 数 
1] 5.88 

> signif (5990000, 2) # 四 会 五 入 ， 保 留 前 2 位 整数 
1] 6e+06 


用 R 语 言 实现 数组 计算 操作 ， 包 括 求 最 大 值 、 求 最 小 值 、 范 


罩 、 求 和 、 均 值 、 加 权 平 均 、 连 乘 、 差 分 、 秩 、 中 位 数 、 分 位 数 、 任 意 数 、 全 体 数 。 


> d«-seq (1, 10, 2) ; d # 定义 1 个 向 量 

到 335 789 

> max (d) ; min (d) ; range (d) # 求 最 大 值 、 最 小 值 、 范 围 range 
1] 9 

1]1 

1119 

> sum (d) ; mean (d) dome. HM 
1] 25 
31-5 
> weighted.mean (d, rep (1, 5) ) # 加 权 平 均 
1] 5 

> weighted.mean (d, c (1, 1, 2, 2, 2) ) 

1] 5.75 

> prod (1: 5) +k 


> diff (d) # 差分 


m 
m 
N 
o 


> rank (d) P 
> median (d) # 中 位 数 
5 


quantile (d) # 分 位 数 

& 25% 50$ 75$ 100% 

3- "5 cg 9 

any (d«5) ; all (d«5) # 任意 条 件 any， 全 体 条 件 al1 
1] TRUE 

1] FALSE 


用 R 语 言 实现 排列 组 合计 算 操作 ， 包 括 阶乘 、 组 合 、 排 列 。 


> factorial (5) # HAS! 

1] 120 

> choose (5， 2) # 组 合 ， 从 5 个 中 选 出 2 个 

1] 10 

» combn (5, 2) d 列 出 从 5 个 中 选 出 2 个 的 所 有 组 合 项 
BT A EF, 10] 

二 | 1 t 1 n 2 2 2 3 3 4 

25.1 2 3 4 5 3 4 5 4 5 5 

> for (n in 0: 10) print (choose (n, k= 0: n) ) # 计算 0: 10 的 组 合 个 数 

1]1 

1111 

1112 1 

1113 3 t 

1114 6 4 l 

1] 1 5 10 10 5 L 

17 1 6 15-20 15 6 1 

11172135 35 21 7 i 

11182856 70 56 28 8 1 

1] 1 9 36 84 126126 84 36 9 1 

1 1 10 45 120 210 252 210 120 45 10 i 

» choose (5, 2) *factorial (2) # 排列 ， 从 5 个 中 选 出 2 个 

1] 20 


R 语 言 实现 累积 计算 操作 ， 包 括 累加 、 累 乘 、 最 小 累积 、 最 大 累积 。 


> cumsum (1: 5) 


1] 1 3 61015 
» cumprod (1: 5) 
1] i 2 6 24 120 


> e«-seq (-3, 3) ; e 

1] -3-2 -L 0 I 2 3 
> cumin (e) 

4] -3-3 -7-3 -3-3 
> cummax (e) 
1]-3-2-10 12 3 


# 累加 
PORE 
# 定义 一 个 向 量 
# 最 小 累积 cummin 


# 最 大 累积 cummax 


R 语 言 实现 两 个 数组 的 计算 操作 ， 包 括 取 交 集 、 并 集 、 差 集 、 数 组 是 否 相等 、 取 唯一 、 查 匹配 元 素 的 索引 、 找 重复 元 素 索引 。 


>x Z- œ (9: 20, 
1 9:10 TL 12 13 14 


15 


18 3.4 56701 
> y<- 1: 10; 

1] 12 34 5 6 7 
» intersect (x, y) 


i 
] 91012 34 5 
» union (x, y) 
1 9 10 11 12 13 14 
8 


6 70 8 


1] 11 12 13 14 15 16 
» setequal (x, y) 
1] FALSE 
» unique (c (x, y) ) 
1 9 10 11 12 13 14 
18 6 7.0 8 
» which (x $in$ y) 
1 1 213 14 15 16 
18] 29 30 31 
» which (is.element (x, 
1 1 213 14 15 16 
18] 29 30 31 
wi 
xi 


> which (duplicated (x) ) 


18 19 20 24 25 26 


Lh py. 3 


0: 8) ; x + 定义 两 个 数组 向 量 
17181920 1 2 3 4 5 
34526278 
9 10 
# 交集 
7 8 
V 并 集 


17181920 12 3 4 5 


+ 差 集 ， 从 Xx 中 排除 y 
1920 0 


# 判断 是 否 相等 


+ He 
17181920 1 2.3 4 5 


+ 找到 x 在 y 中 存在 的 元 素 的 索引 
19 20 21 22 24 25 26 27 28 


# 同和 in 多 
19 20 21 22 24 25 26 27 28 


* 找到 重复 元 素 的 索引 
29 30 


122 三角 函数 计算 
1. 三 角 函 数 


在 直角 三 角形 中 仅 有 锐角 (大 小 在 0~90 度 之 间 的 角 ) 三 角 函 数 的 定义 。 给 定 一 个 锐角 6， 可 以 做 出 一 个 直角 三 角形 ， 使 得 其 中 的 一 个 内 角 是 6。 设 这 个 三 角形 中 ，6 的 对 边 、 邻 边 和 斜 边 长 度 分 别 是 a、b 


1-3 所 示 。 


和 h， 如 图 


1 


图 1-3 直角 三 角形 


三 角 函 数 的 6 种 关系 : E, R ED, RI, ER REL 


: 0 的 正弦 是 对 边 与 斜 边 的 比值 ; sing=a/h 


:6 的 余弦 是 邻 边 与 斜 边 的 比值 : cos0-b/h 


“ 6 的 正切 是 对 边 与 邻 边 的 比值 : tan9=a/b 


“ 6 的 余 切 是 邻 边 与 对 边 的 比值 : cot0=b/a 


: 6 的 正 害 是 儿 边 与 邻 边 的 比值 : sec6=h/b 


“ 6 的 余 割 是 儿 边 与 对 边 的 比值 : csc0=h/a 


三 角 函 数 的 特殊 值 。 


n/12 x/6 n/4 
(46-42y4 1⁄2 4272 
(46-42y4 4372 42 2 
2-43 43 /3 1 

cot NA 2-445 4,5 l 

sec l 6 一 AZ 243 /3 42. 

cse NA 2 42 243 /3 


用 R 语 言 实 现 三 角 基 本 函数 计算 ,包括 正 弦 、 余 弦 、 正 切 。 


函数 


sin 


O = O O 


5/(12*n) 
(46 +42 y4 
(46 - 42 )/4 
24-43 
2-43 

46 -42 

1 


0/2 


X 7 7 Cy 


» sin (0) ; sin (1) ; sin (pi/2) # 正弦 
[1] 

[1] 0.841471 

[ 


> cos (0) ; cos (1) ; cos (pi) # 余弦 
[1] 0.5403023 
> em (0) ; tan (1) ; tan (pi) E2537] 
E Tasiok 


[1] -1.224647e-16 


接 下 来 ， 我 们 用 ggplot2 包 来 画 出 三 角 函 数 的 图 形 。 


> library (ggplot2) # 加 载 ggplot2 的 库 
> library (scales) 


三 角 函 数 画图 ， 以 下 代码 生成 三 角 函 数 曲 线 ， 如 图 1-4 所 示 。 


> x«-seq (-2*pi, 2*pi, by-0.01) # x 坐标 
> sl<-data.frame (x, y=sin (x) , type=rep ('sin', length (x) 


3 + y 坐 标 ,正弦 
> s2«-data.frame (x, y-cos (x) , type=rep ('cos', length (x) ) ) # Y 坐 标 ， 余 弦 
> s3«-data.frame (x, y-tan (x) , type-rep ('tan', length (x) ) ) + yY 坐 标 ， 正 切 
> s4<-data.frame (x, y-l/tan (x) , type-rep ('cot', length (x) ) ) yk, 4 
» s5«-data.frame (x, y-1/cos (x) , type-rep ('sec', length (x) ) ) + yE, EF) 
> s6<-data.frame (x, y=1/sin (x) , type=rep ('csc', length (x) ) ) + Y 坐 标 ， 余 割 
> df«-rbind (sl, s2, s3, s4, s5, s6) 
» g«-ggplot (df, aes (x, y) ) # 用 ggplot2 画 图 


> g<-gtgeom line (aes (colour-type, stat-'identity') ) 

> g«-gscale y continuous (limits-c (-2, 

> g«-grscale > X continuous (breaks-seq (-2*pi, 2*pi, by-pi) , labels-c ("-2*pi", 
"Ipi", "0", "pi", "2*pi") ) 

> 9 


图 1-4 三 角 函 数 曲 线 


2. 反 三 角 函 数 


基本 的 反 三 角 函 数 定义 如 下 。 


反 三 角 函 数 定义 值 域 

arcsin(x) = y sin(y) ^ x -7/2 <= y <= v2 
arccos(x) = y cos(y) =x Q«yc—m 

arctan(x) — y tan(y) ^ x -7/2 < y < /2 
arcese(x) = y esc(y) =x -q/2 <= y <= m2, y!=0 
arcsec(x) = y sec(y) x 0 «— y «— m, y!7n/2 
arccot(x) = y cot(y) =x 0cyc«mn 


用 R 语 言 实现 反 三 角 函 数 的 计算 ， 包 括 反正 弦 、 反 余弦 、 反 正切 。 


> asin (0) ; asin (1) 4 反正 弦 asin 
[1] 0 

[1] 1.570796 # pi/2=1.570796 

> acos (0) ; acos (1) 4 反 余弦 acos 
[1] 1.570796 # pi/2-1.570796 

[1] 0 

» atan (0) ; atan (1) 4 反正 切 atan 
[1] 0 

[1] 0.7853982 # pi/4-0.7853982 


RZARAHEHA, UFRBERR- ARA, BDETT-5Pn. 


> x<-seq (-1, 1, by=0.005) # x 坐标 

> sl<-data.frame (x, y-asin (x) , type-rep ('arcsin', length (x) ) ) 

> s2«-data.frame (x, y-acos (x) , type-rep ('arccos', length (x) ) ) 

> s3«-data.frame (x, y-atan (x) , type-rep ('arctan', length (x) ) ) 

» s4«-data.frame (x, y-l/atan (x) , type-rep ('arccot', length (x) * 
) 


> s5«-data.frame (x, y-l/asin (x) , type-rep ('arcsec', length (x) 

> s6«-data.frame (x, y-l/acos (x) , type-rep ('arccsc', length (x) 

> df«-rbind (s1, s2, s3, s4, s5, s6) 

> g<-ggplot (df, aes (x, y) ) 4 Hggplot2i HB] 

> g«-gtgeom line (aes (colour-type, stat-'identity') ) 

> g«-g*scale y continuous (limits-c (-2*pi, 2*pi) , breaks-seq (-2*pi, 2*pi, by-pi) , 
labels-c ("-2*pi", "-pi", "0", "pi", "2*pi") ) 


) 
) 
) 


2g 


-1.0 -0.5 0.0 0.5 1.0 
x 


图 1-5 反 三 角 函 数 曲 线 


3. 三 角 函 数 公式 


接 下 来 ， 用 单元 测试 的 方式 来 描述 三 角 函 数 的 数学 公式 ， 公 式 的 左边 等 于 公式 的 右边 。 通 过 testthat 包 进行 单元 测试 ， 关 于 testthat 包 的 安装 和 使 用 ， 请 参考 5.2 节 。 


使 用 expect that (right, left) 函数 ， 把 公式 的 左右 两 边 表达 式 ， 分 别 以 参数 形式 传 入 函数 中 。 运 行 expect_that () 函数 ， 如 果 没有 返回 结果 则 表示 两 个 参数 相等 ， 如 果 有 输出 则 根据 输出 查看 原 


因 。 

> library Me stthat) # 加 载 testthat 包 
a«-5; b«- # 定义 变量 
平方 和 公式 : 

n( ) ] E LI 
E - — _ E cE Sm 
四 
| i | 
n (a) ^2*cos (a) ^2 

Ht E 
expect that (1, equals (sin (a) ^2*cos (a) ^2) ) Ryu 起 的 方法 ， 判 断 公 WIDE 

> expect that (2, equals (sin (a) ^2*cos (a) ^2) ) 如 果 公式 两 边 不 相等 ， 会 有 错误 提 
Error: 2 m bet in (a) ^2 * cos (a) ^2 


: not equa 
Mean relative differ 


HAAR: 


sin(a+b)=sin(a)cos(b)+sin(b)cos(a) 
sin(a—b)-sin(a)cos(5)-sin(5)cos(a) 
cos(a4-b)-cos(a)cos(5)-sin(5)sin(a) 
cos(a-b)-cos(a)cos(b)*sin(5)sin(a) 
tan(a-c-5)-(tan(a)-tan(5))/(1-tan(a)tan(5)) 
tan(a—-b)-(tan(a)-tan(5))/(1--tan(a)tan(^)) 


和 角 公 式 的 单元 测试 如 下 : 
> expect that (sin (a) *cos (b) n (b) (a) , equals (sin (atb) ) ) 
expect that (sin (a) *cos (b) (b) (a) , equals (sin (a-b) ) ) 
xpect that (cos (a) *cos (b) (b) *sin (a) , equal (e (a+b) ) ) 
> expect that (cos (a) s (b n AB eer (a) , equals (cos (a-b) ) ) 
> expect that ( (tan (a) itor (b) B y (1-tan (a) *tan (o) Y) , E (tan (a+b) ) ) 
expect that ( (tan (a) -tan (b) ) / (1*tan (a) *tan (b) ) quals (tan (a-b) ) ) 
2 倍 角 公式 : 


sin(2a)-2sin(a)cos(a) 
cos(2a)-cos (a)-sin (a)-2cos (a)-1-1 -2sin' (a) 


2 倍 角 公式 的 单元 测试 如 下 : 


> expect that (cos (a) ^2-sin 
» expect that (2*c a ) “2- 
n (a) ^2, 


a) ^2, e cos (2*a) 
equals (cos (2*a) ) ) 
> expect that (1- 2 quals 


3 倍 角 公式 : 


cos(3a)-4cos (a)-3cos(a) 


sin(3a)--4sin (a) 3sin(a) 


sin(a/2) 2» £4 (1 - cos(a))/2 


cos(a/2) 2 :J(1 * cos(a))/2 
|, av 17€0s(a) sin(a) 
tan(a2) = sin(a) — 1-*cos(a) 


sinlideos( (airtel sina 002 
cos(a)sin(5)-(sin(a-cb)-simn(a-5b))/2 
cos(a)cos(5)-(cos(a-b5)-cos(a-b))/2 
sin(a)sin(5)-(cos(a-b)-cos(a--b))/2 


sin(a)-sin(5)-2sin((a--5)/2)cos((a4-5)/2) 
sin(a)-sin(5)-2cos((a--5)/2)cos((a—-5)/2) 
cos(a)-*cos(5)-2cos((a--b)/2)cos((a—-b)/2) 
cos(a)-cos(5)—-2sin((a--5)/2)sin((a—-5)/2) 


万 能 公式 


sin(2a)-2tan(a)/( 1--tan'(a)) 
cos(2a)=(1-tan (a))/(1-9-tan' (a)) 
tan(2a)-2tan(a)/(1-tan'(a)) 


cos(a--b)cos(a-b)-cos' (a)sin (b) 


. Tcos(2a))/2 
in (a)-(1-cos(2a))/2 


降 次 升 角 公 式 的 单元 测试 如 下 : 


> expect that ( (1+cos (2*a) ) /2, equals (cos (a) ^2) ) 
» expect that ( (1-cos (2*a) ) /2, equals (sin (a) ^2) ) 


| 


asin(a)* bcos(a) =y a? * b^ sin(x + arctan(b/a) 


助 角 公 式 的 单元 测试 如 下 : 


> expect that (sqrt (a^2+b^2) *sin (atatan (b/a) ) , equals (a*sin (a) *b*cos (a) ) ) 


123 ”复数 计算 


复数 为 实数 的 延伸 ， 它 使 任 一 多 项 式 都 有 根 。 复 数 中 的 虚数 单位 |， 是 -1 的 一 个 平方 根 ， 即 ?=-1。 任 一 复数 都 可 表达 为 x+yi， 其 中 x 及 y 皆 为 实数 ， 分 别称 为 复数 之 “ 实 部 ”和 “ 庶 部 ”。 


1. 创 建 一 个 复数 


> ai«-542i; ai + 直接 创建 复数 

1] 542i 

> class (ai) # 查看 复数 的 类 型 

1] "complex" 

> bi<-complex (real=5, imaginary=2) ; bi 4 通过 complex () 函数 创建 复数 
1] 542i 

» is.complex (bi) 


» Re (ai) # 实数 部 分 
> Im (ai) # 虚数 部 分 


> Mod (ai) # 取 模 

1] 5.385165 # sqrt (5^2+2^2) = 5.385165 
> Arg (ai) ET 

1] 0.3805064 

» Conj (ai) ox 

1] 5-2i 


2. 复 数 四 则 运算 

“ 加 法 公式 : (atbi) + (cdi) = (a+c) + (bed) i 

* 减法 公式 : (atbi) - (ctdi) = (a-c) + (b-d) i 

- 乘法 公式 : (atbi) (c+di) =ac+adi+bci+bidi=ac+bdi2+ (ad+bc) i= (ac-bd) + (ad+bc) i 


“ 除法 公式 : (atbi) / (c+di) = ( (ac+bd) + (be-ad) i) / (c2+d?) 


> a<-5; b<-2; c<-3; d<-4 
> ai<-complex (real=a, imaginary-b) 
> bi<-complex (real=c, imaginary=d) 


复数 四 则 运算 的 单元 测试 如 下 : 


expect that (complex (real= (a+c) , imaginary- (b+d) ) , equals (ai+bi) ) 

expect that (complex (real- (a-c) , imaginary- (b-d) ) , equals (ai-bi) ) 

expect that (complex (real- (a*c-b*d) , imaginary- (axd+bxc) ) , equals (ai*bi) ) 

expect that (complex (real- (a*c*b*d) , imaginary- (b*c-a*d) ) / (c^24d^2) , equals (ai/bi) ) 


Vvvv 


3. 复 数 开平 方 根 


> sqrt (-9) # 在 实数 域 ， 给 -9 开平 方 根 

[1] NaN 

Warning message: 

In sqrt (-9) : NaNs produced 

> sqrt (complex (real--9) ) # 在 复数 域 ， 给 -9 开平 方 根 
[1] 043i 


124 方程 计算 


方程 计算 是 数学 计算 的 一 种 基本 形式 ，R 语 言 也 可 以 很 方便 地 帮助 我 们 解 方程 ， 下 面 将 介绍 一 元 多 次 方程 和 二 元 一 次 方程 的 解法 。 解 一 元 多 次 方程 ， 可 以 用 uniroot () 函数 。 


1. 一 元 一 次 方程 


一 元 一 次 方程 : ax+b=0， 设 a=5，b=10， 求 x? 


> fl <- function (x, a, b) a*xtb d 定义 方程 函数 

> a<-5; b<-10 * 给 a，b 常 数 赋值 

> result «- uniroot (fl, c (-10, 10) , a-a, b-b, tol-0.0001) # 在 (-10, 10) 的 区 间 ， 精 确 度 
# 为 0.0001 位 ， 计 算 方 程 的 根 

> result$root # 打印 方程 的 根 X 

1] -2 


一 元 一 次 方程 非常 容易 解 得 ， 方 程 的 根 是 -2! 以 图 形 展示 函数 : y=5x+10， 如 图 1-6 所 示 。 


> x«-seq (-5, 5, by-0.01) # 创建 数据 点 

> y<-f1 (x, a, b) 

> df«-data.frame (x, y) 

» g«-ggplot (df, aes (x, y) ) * 用 ggplot2 来 画图 
> g<-gtgeom line (col-'red') # 红色 直线 

> g<-gtgeom point (aes (result$root, 0) , col-"red", size-3) 点 
> g<-gtgeom hline (yintercept-0) *geom : Sm (yintercept- 0) LEE 坐标 轴 

> g<-g+ggtitle (paste ("y =", a, "* x +", 

> 9 


7 10 


图 1-6 ”函数 Y=5x+10 


一 元 二 次 方程 


一 元 二 次 方程 : ax2+bx+c=0， 设 a=1，b=5，c=6， 求 x? 


> f2 <- function (x, a, b, c) a*x^24b*x4c 

» a«-1; b«-5; c«-6 

» result «- uniroot (f2, c (0, -2) , a-a, b-b, c-c, tol-0.0001) 
> result$root 

[1] -2 


把 参数 带 入 方程 ， 用 uniroot () 函数 ， 我 们 就 解 出 了 方程 的 一 个 根 ， 改 变 计算 的 区 间 ， 我 们 就 可 以 得 到 另 一 个 根 。 


> result «- uniroot (f2, c (-4, -3) , a-a, b-b, c-c, tol-0.0001) 
> result$root 
[1] -3 


方程 的 两 个 根 ， 一 个 是 -2， 一 个 是 -3。 


由 于 uniroot () 函数 每 次 只 能 计算 一 个 根 ， 而 且 要 求 输入 的 区 间 端 点 值 必须 是 正 负 号 相反 的 。 如 果 我 们 直接 输入 (-10, 0) 这 个 区 间 ， 那 么 uniroot () 函数 会 出 现 错误 。 


> result «- uniroot (f2, c (-10, 0) , a-a, b-b, c-c, tol-0.0001) 
Error in uniroot (f2, c (-10, 0 =a, b=b, c=c, tol = 1e-04) 
F 位 于 极点 边 的 O 值 之 正人 负重 不 相反 


这 应 该 是 uniroot () 为 了 统计 计算 一 元 多 次 方程 而 设计 的 ， 所 以 为 了 使 用 uniroot () 函数 ， 我 们 需要 取 不 同 的 区 间 来 获得 方程 的 根 。 以 图 形 展示 函数 : y=x2+5x+6， 如 图 


1-7 所 示 。[1] 


> x<-seq (-5, 1, by=0.01) * 创建 数据 点 

» y«-£2 (x, a, b, c) 

» df«-data.frame (x, y) 

» g«-ggplot (df, aes (x, y) ) 4 用 ggplot2 来 画图 
> g«-g*geom line (col='red') # 红色 曲线 


> g«-g*geom hline (yintercept-0) *geom vline (yintercept-0) + 坐标 轴 
> g<-gtggtitle (paste ("y =", a, "* x = 24" b, "* x &", c) ) 
29 


y=x +5x+6 


图 1-7 ky 5x6 
我 们 从 图 1-7 中 可 以 很 明显 看 到 x 的 两 个 根 的 取信 范围 。 
3 一 元 三 次 方程 


一 元 三 次 方程 : ax3+bx2+cx+d=0， 设 a=1，b=5，c=6，d=-11， 求 x? 


> f3 <- function (x, a, b, c, d) a*x^3tb*x^24c*x4d 

> a«-1; b«-5; c«-6; d«--11 

» result «- uniroot (f3, c (-5, 5) , a-a, b-b, c-c, d-d, tol-0.0001) 
> result$root 

[1] 0.9461458 


如 果 我 们 设置 对 了 取 值 区 间 ， 那 么 很 容易 就 可 以 得 到 方程 的 根 。 以 图 形 展示 函数 : y=x3+5x2+ 6x-11， 如 图 1-8 所 示 。 


> x<-seq (-5，5，by=0.01) * 创建 数据 点 

> y«-£3(x,a,b,c, d) 

» df«-data.frame (x, y) 

» g«-ggplot (df, aes (x, y) ) * 用 ggPlot2 画 图 
> g<-gtgeom line (col='red') # 3 次 曲线 
> g«-g*geom hline (yintercept-0) *geom vline (yintercept=0) P 坐标 

> g«-giggtitle (paste ("y =", a, "* x ^3 t", b, "* x ^2 t", c, "* x & ", d) ) 
>g 


yox 5x .6x4-11 


图 1-8 ”函数 y=x3+5x2+6x-11 


4. 二 元 一 次 方程 组 


R 语 言 还 可 以 用 来 解 二 元 方程 组 ， 当 然 计算 方 法 其 实 是 利用 了 和 矩阵 计算 。 


下 面 是 x1，x2 两 个 未 知 变量 组 成 的 方程 组 ， 求 x1，x2 的 值 。 


l JH 


wl 1 T 


以 矩阵 形式 来 构建 方程 组 就 是 


me [ 
E" 
r 
"2 

ETT 
> lf«-matrix (c (3, 5, 1, 2) , nrow-2, byrow-TRUE) 4 AIH 
» rf«-matrix (c (4, 1) , nrow-2) LE 
» result«-solve (lf, rf) 4 计算 结果 
> result 

DL, 1] 

(1; ] 3 
[2,1 - 


得 方程 组 的 解 ，x1，x2 分 别 为 3 和 -1。 


i 


接 下 来 ， 我 们 画 出 这 两 个 线性 方程 的 图 ， 如 图 1-9 所 示 。 设 y=x2，x=x1， 把 原 方程 组 变 成 两 个 函数 形式 。 
> fyl«-function (x) (-3*x44) /5 # 定义 2 个 函数 

> fy2<-function (x) (-1*x41) /2 

> x<-seq (-1, 4, by-0.01) # 定义 数据 

> yl«-fyl (x) 

» y2«-ty2 (x) 

> dyl«-data.frame (x, y-yl, type-paste ("y= (-3*x*4) /5") ) 

> dy2«-data.frame (x, y=y2, type-paste ("y= (-1*x*1) /2") ) 

» df «- rbind (dyl, dy2) 

» g«-ggplot (df, aes (x, y) ) * 用 ggplot2 画 图 
> g<-g+geom line (aes (colour-type, stat-'identity') ) F 2 条 直线 
> g<-gtgeom hline (yintercept-0) 4geom vline (yintercept-0) # 坐标 轴 
>g 


x 


图 1-9 ”二 元 一 次 方程 组 


我 们 看 到 两 条 直线 交点 的 坐标 就 是 方程 组 的 两 个 根 。 多 元 一 次 方程 同样 可 以 


通过 R 语 言 ， 我 们 实现 了 对 初等 数学 的 各 种 计算 ， 真 的 是 非常 方便 。 


[1] 请 读者 自己 运行 R 语 言 代码 ， 查 看 生成 的 彩色 图 。 


这 种 方法 来 解 得 。 


1.3 ”概率 基础 和 R 语 言 
问题 


如 何 用 RR 语言 学 习 概 率 ? 


了 语言 是 统计 语言 ， 


概率 又 是 统计 的 基础 ， 所 以 可 以 想到 ，R 语 言 


号 


必然 要 从 底层 API 上 提供 完整 、 方 便 、 易 用 的 概率 计算 的 函数 。 下 面 就 让 R 语 言 帮 我 们 学 好 概率 的 基础 课 。 
1.3.1 ”随机 变量 介绍 


随机 变量 (random variable) 表示 随机 现象 各 种 结果 的 实 值 函数 ， 定 义 在 样本 空间 9 上 。 由 于 它 的 自 变量 是 随机 试验 的 结果 ， 而 随机 试验 结果 的 出 现 具有 随机 性 ， 因 此 ， 随 机 变量 的 取 值 具有 一 定 的 随 
机 性 。 样 本 空间 是 随机 试验 的 一 切 可 能 的 基本 结果 组 成 的 集合 ， 记 为 S。 样 本 空间 的 元 素 ， 即 随机 试验 的 每 一 个 可 能 的 结果 ， 称 为 样本 点 。 


如 果 随 机 变量 x 的 全 部 可 能 的 取 值 只 有 有 限 多 个 ， 则 称 x 为 离散 型 随机 变量 。 如 果 随 机 变量 可 以 在 某 个 


区 间 内 取 任 意 实数 ， 即 变量 的 取 值 可 以 是 连续 的 无 穷 多 个 ， 这 种 


随机 变量 就 称 为 连续 型 随机 变量 。 
本 节 的 系统 环境 是 : 


* Windows 7 64bit 


“ R: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 


R 程 序 : 生成 在 样本 空间 (1, 2, 3, 4, 5) 上 的 离散 型 随机 变量 X，X 只 能 取 值 1，2，3，4 或 5。 


> S<-lr 5 
> x<-sample (S, 1) ; x 


112 


下 面 的 程序 生成 在 样本 空间 (0, 1) 上 的 连续 随机 变量 Y， 取 10 个 值 。 


> y«-runif (10, 0, 1) ; y 
[1] 0.3819569 0.7609549 0.6692581 0.6314708 0.5552201 0.8225527 0.7633086 
0.4667188 0.1883553 0.3741653 


概率 分 布 用 以 表述 随机 变量 取 值 的 概率 规律 。 为 了 方便 使 用 ， 根 据 随 机 变量 所 属 类 型 的 不 同 ， 概 率 分 布 取 不 同 的 表现 形式 。 


:离散 型 分 布 : 两 点 分 布 、 二 项 分 布 、 泊 松 分 布 等 
“ 连续 型 分 布 : 均匀 分 布 、 指 数 分 布 、 正 态 分 布 、 伽 玛 分 布 等 


在 1.4 节 中 ， 将 介绍 连续 型 分 布 函数 的 R 语 言 实现 。 


1.3.2 ”随机 变量 的 数字 特征 


接 下 来 ， 我 们 将 介绍 随机 变量 的 数字 特征 ， 这 些 指标 特征 都 是 概率 论 中 常用 的 概念 。 数 学 期 望 、 方 差 、 标 准 差 、 分 位 数 (最 大 值 、 最 小 值 、 中 位 数 、 四 分 位 数 ) 、 协 方差 、 相 关系 数 、 矩 (包括 原点 
和 矩 、 中 心 矩 、 偏 度 、 峰 度 ) 、 协 方差 矩阵 。 


1 数学 期 户 


离散 型 随机 变量 的 一 切 可 能 的 取 值 x; 与 对 应 的 概率 pj 之 积 的 和 称 为 该 离散 型 随机 变量 的 数学 期 望 (mathematical expectation) ， 记 为 E (X) ， 如 公式 (1.1) 所 示 。 数 学 期 望 是 最 基本 的 数学 特征 之 
一 ， 反 映 随机 变量 平均 取 值 的 大 小 。 我 们 通常 也 把 数学 期 望 也 叫做 均值 。 


E(X) = >, Xp (1.1) 


i 


下 面 的 R 程 序 计算 数据 集 (1, 2, 3, 7, 21) 的 数学 期 望 。 


«-c (0, 2,3, 7, 21) 
e: 


> 
> mean (S) + 计算 样本 的 数学 期 望 
[ 6.8 


—Ht 


1 


连续 型 随机 变量 : 若 随机 变量 X 的 分 布 函数 F (x) 可 表示 成 一 个 非 负 可 积 函 数 f (x) 的 积分 ， 则 称 X 为 连续 型 随机 变量 ，f (x) 称 为 X 的 概率 密度 函数 ， 积 分 值 为 X 的 数学 期 望 ， 记 为 E OX) ， 如 公式 
(1.2) 所 示 。 


a 


E(X) = | xf(x)dx Cx) 


“00 


方差 (variance) 是 各 个 数据 与 平均 数 之 差 的 平方 的 平均 数 ， 用 来 度量 随机 变量 与 其 数学 期 望 之 间 的 偏离 程度 。 设 X 为 随机 变量 ， 如 果 E{[X-E OO ]2} 存 在 ， 则 称 E[X-E (X) ]2} 为 X 的 方差 ， 记 为 
Var (X) ， 如 公式 (1.3) 所 示 。 


Var(X)-E([X- E(X]) 或 Var(X) - E(X) - [EQO] ( L3) 


下 面 的 R 程 序 计算 数据 集 (1, 2, 3, 7, 21) 的 方差 。 


> S«-c (1, 2, 3, 7, 21) 


» var (S) # 计算 样本 的 方差 

[1] 68.2 

> sum ( (S-mean (S) ) ^2) / (length (S) -1) + 手动 计算 样本 的 方差 
[1] 68.2 

3. 标 准 差 


标准 差 (standard deviation) 是 方差 的 算术 平方 根 ,var(Z)， 反 映 一 个 数据 集 的 离散 程度 。 两 个 数据 集 的 平均 数 相同 ， 但 标准 差 未 必 相 同 。 下 面 的 R 程 序 计算 数据 集 (1, 2, 3, 7, 21) 的 标准 差 。 


»S$«-o (1, 2,3, 7, 21) 
> sd (S) # 计算 样本 的 标准 差 
[1] 8.258329 


4 分 位 数 


众 数 (mode) 是 一 组 数据 中 出 现 次 数 最 多 的 数值 ， 有 时 众 数 在 一 组 数 中 有 好 几 个 。 下 面 的 R 程 序 计 算数 据 集 (1, 2, 3, 3, 3, 7, 7, 7, 7, 9, 10, 21) 的 众 数 。 


Sg li A 3, 33 Ta 75 7, 75 9, 10s 21) 
> names (which.max (table (S) ) ) oA 
nu] "7" 


最 小 值 (minimum) 是 在 给 定 情形 下 可 以 达到 的 最 小 数量 或 最 小 数值 。 下 面 的 R 程 序 计算 数据 集 (2, 3, 3, 3, 7, 7, 7, 7, 9, 10, 21) 的 最 小 值 。 


> S«-c (2, 3, 3, 3, 7, 7, 7, 7, 9, 10, 21) 

» min (S) # 最 小 值 
[1] 

> 

[ 


which.min (S) # 最 小 值 的 索引 
1] 


MS 


eb 


最 大 值 (maximum) 是 在 给 定 情形 下 可 以 达到 的 最 大 数量 或 最 大 数值 。 下 面 的 R 程 序 计算 数据 集 (2, 3, 3, 3, 7, 7, 7, 7, 9, 10, 21) 的 最 大 值 。 


» S«-c (2, 3, 3, 3, 7, 7, 7, 7, 9, 10, 21) 
» max (S) # 最 大 值 
[1] 21 


» which.max (S) # 最 大 值 的 索引 
[1] 11 


中 位 数 (median) 是 指 将 统计 总 体 当 中 的 各 个 变量 值 按 大 小 顺序 排列 起 来 ， 形 成 一 个 数列 ， 处 于 变量 数列 中 间 位 置 的 变量 值 就 称 为 中 位 数 。 下 面 的 R 程 序 计算 数据 集 (1，2，3，4，5) 的 中 位 数 。 


S«-c (1, 2, 3, 4, 5) 
median (S) # 中 位 数 
] 


E 
E 
[1] 3 


四 分 位 数 (quartile) 用 于 描述 任何 类 型 的 数据 ， 尤 其 是 偏 态 数据 的 离散 程度 ， 即 将 全 部 数据 从 小 到 大 排列 ， 正 好 排列 在 上 1/4 位 置 叫 上 四 分 位 数 ， 下 1/4 位 置 上 的 数 就 叫做 下 四 分 位 数 。 下 面 的 R 程 序 计 
算数 据 集 (1, 2, 3, 4, 5, 6, 7, 8, 9) 的 四 分 位 数 。 


> S«-c (1, 2, 3, 4, 5, 6, 7, 8, 9) 
» quantile (S) # 四 分 位 数 
0$ 25$ 50$ 75$ 100% 
1 3 5 gi 9 
» fivenum (S) # 5 个 分 位 值 
[1] 13579 


R 中 也 有 通用 的 统计 计算 函数 summary () . ÆRES F, summary () 函数 对 上 面 的 几 个 常用 统计 量 进行 了 封装 ， 直 接 把 数据 集 传 和 summary () 函数 ， 可 以 很 方便 地 看 到 计算 结果 。 下 面 的 R 程 序 
计算 数据 集 (1，2，3，4，5，6，7，8，9) 的 统计 函数 。 


>» 7,58, 9) 


> summary (S) + 统计 函数 
Min. 1st Qu. Median Mean 3rd Qu. Max. 
1 3 5 5 d 9 
5.407525 


157525 (covariance) 用 于 衡量 两 个 变量 的 总 体 误 差 。 而 方差 是 协 方差 的 一 种 特殊 情况 ， 即 当 两 个 变量 是 相同 的 情况 。 设 X，Y 为 两 个 随机 变量 ， 称 E{[X-E (X) JY-E (Y) ]} 为 X 和 Y 的 协 方差 ， 记 为 
Cov (X, Y) ， 如 公式 (1.4) 所 示 。 


Cov(X, Y) = E ((X - EQO][Y - E(Y)]) (1.4) 


下 面 的 R 程 序 计算 X (1, 2, 3, 4) 和 Y (5, 6, 7, 8) 的 协 方差 。 


» X«-c (1, 2, 3, 4) 

» Y«-c (5, 6, 7, 8) 

» cov (X, Y) # 协 方 差 
[1] 1.666667 


6. 相 关系 数 


相关 系数 (correlation coefficient) 是 用 来 反映 变量 之 间 相 关 关 系 密切 程度 的 统计 指标 。 相 关系 数 是 按 积 差 方法 计算 ， 同 样 以 两 变量 与 各 自 平 均值 的 离 差 为 基础 ， 通 过 两 个 离 差 相 乘 来 反映 两 变量 之 间 
的 相关 程度 。 当 Var (X) >0，Var (Y) »O0Bj, RREA N / VarGO Var XSARA, nest (1.5) Bm. 


0051) = Rar (X) Var(Y) 


下 面 的 R 程 序 计算 X (1, 2, 3, 4) 和 Y (5, 7, 8, 9) 的 相关 系数 。 


> Xece (1, 2, 3, 4) 
> Y«-c (5, 7, 8, 9) 


» cor (X, Y) # 相关 系数 

[1] 0.9827076 

748 

和 矩 是 广泛 应 用 的 一 类 数学 特征 ， 均 值 和 方差 分 别 就 是 一 阶 原点 和 矩 和 二 阶 中 心 矩 。 


原点 矩 (moment about origin) : 对 于 正 整数 k， 如 果 E (XK) 存在 ， 称 ak=E (X) 为 随机 变量 X 的 k 阶 原点 和 矩 。X 的 数学 期 望 是 X 的 一 阶 原点 矩 ， 即 E (X) ， 如 公式 (1.6) 所 示 。 


qa, = E(X") = | ^xtar() ( 1.6) 


ar 
下 面 的 R 程 序 计算 5 (1, 2, 3, 4, 5) 的 一 阶 原 点 矩 (均值 ) 。 
SC 3 
> mean (S) + R EE 


[1] 3 


ÒE (moment about centre) : 对 于 正 整数 Kk， 如 果 E (X) FE, HE ([X-E (X) ]9 也 存在 ， 则 称 E[IX-E (X) ]k 为 随机 变量 X 的 k 阶 中 心 矩 。X 的 方差 是 X 的 二 阶 中 心 矩 ， 即 E (D-E (X) 19 ， 如 
公式 (1.7) Bran. 


E 


ti = E(X- EQ0] = | -EX dF) (1.7) 


oo 


下 面 的 R 程 序 计算 S (1, 2, 3, 4, 5) BS—ErrPDoB. (方差 ) 。 


> S<-c (1, 2, 3, 4, 5) 
» var (S) # Bpo 
[1] 


偏 度 (skewness) 是 统计 数据 分 布 偏 斜 方向 和 程度 的 度量 ， 是 统计 数据 分 布 非 对 称 程度 的 数字 特征 。 设 分 布 函 数 F(x) 有 中 心 矩 bz=E OCE (X) ) ?, u3=E (X-E (X) ) 3， 则 Cs=ha/h2^ (3/2) 
为 偏 度 系数 ， 如 公式 (1.8) 所 示 。 


C, = unl ul (1.8) 


当 Cs>0 时 ， 概 率 分 布 偏向 均值 右 侧 ; 当 Cs<0 时 ， 概 率 分 布 偏向 均值 左 侧 。 


下 面 的 R 程 序 计算 10000 个 正 态 分 布 的 数据 集 的 偏 度 。 


> library (PerformanceAnalytics) # 加 载 PerformanceAnalytics 包 
> S«-rnorm (10000) + 取 10000 个 正 态 分 布 随机 变量 的 样本 点 
> skewness (S) + 计算 偏 度 

[1] -0.00178084 

> hist (S, breaks-100) # 画 出 正 态 分 布 的 柱状 图 ， 如 图 1-10 所 示 


100 150 200 


50 


-3 -2 -1 0 1 2 3 


图 1-10 ”10000 个 正 态 分 布 变 量 样本 点 的 柱状 图 


峰 度 (kurtosis) 又 称 峰 态 系数 ， 表 征 概率 密度 分 布 曲线 在 平均 值 处 峰值 高 低 的 特征 数 。 峰 度 刻 划 不 同类 型 的 分 布 的 集中 和 分 散 程序 。 设 分 布 函数 F (x) 有 中 心 矩 Hz=E OCE (X) ) 2，h4=E (X- 
E (X) ) 4， 则 Cr-3 为 峰 度 系数 ， 如 公式 (1.9) 所 示 。 


C, = tul ui - 3 ( 1.9) 


R 语 言 计算 正 态 分 布 的 一 个 大 小 为 10000 的 样本 ( 同 偏 度 的 样本 数据 ) 的 峰 度 : 


> kurtosis (S) # 计算 峰 度 
[1] -0.02443549 


8, 协 方差 矩阵 


协 方差 矩阵 (covariance matrix) 是 一 个 矩阵 ， 它 的 每 个 元 素 是 各 个 向 量 元 素 之 间 的 协 方差 ， 这 是 从 一 维 随机 变量 到 多 维 随机 向 量 的 自然 推广 。 设 X= (X1，X2，.…，Xn) ，Y= (Y1, Y2, ~ Ym) 
为 两 个 随机 变量 ， 则 Cov (X, Y) 为 X，Y 的 协 方差 矩阵 ， 如 公式 (1.10) 所 示 。 


Cov (X, Y) = (65),x» ( 1.10) 


R 语 言 计算 协 方差 矩阵 如 下 。 


> x-as.data.frame (matrix (rnorm (10) , ncol-2) ) 

>+% 
V1 V2 

1 -2.11315384 -2.55189840 

2 -0.96631271 -1.36148355 

3 -0.02835058 -0.82328774 

4 -1.86669567 -0.07201353 

5 0.27324957 -2.23835218 

> cov (x) + 协 方差 矩阵 
V1 V2 

V1 1.13470650 -0.09292042 

V2 -0.09292042 1.03172261 


1.3.3 ”极限 定理 


1. 大 数 定律 


大 数 定律 (law of large numbers) 又 称 大 数 定理 ， 是 判断 随机 变量 的 算术 平均 值 是 否 向 常数 收敛 的 定律 ， 是 概率 论 和 数理 统计 学 的 基本 定律 之 一 。 


设 X1，X2，…，Xk 是 随机 变量 序列 且 E (Xk) 存在 (k=1，2，3，…) ， 令 Yn= (X1+X2+.…+Xk) /n， 若 对 于 任意 给 定 的 2>0， 有 公式 (1.11) RA, 


limP(|E-E(Y)26)-0 或 limP(|JEL-E(YX)«ej-1 6111 3 


n--oo n-oo 


则 称 随机 变量 序列 {Xl 服从 大 数 定律 


t 


作为 上 述 定理 的 特殊 情况 ， 利 用 Chebyshev 不 等 式 ， 设 随机 变量 X 具 有 数学 期 望 E (X) =u, 7525Var (X) =02， 则 对 于 任意 =>0， 如 公式 1.12 所 示 。 


P(X-u26)«2 ( 1.42) 


假设 投掷 一 枚 硬币 ， 得 到 正面 的 概率 是 0.5， 投 4 次 时 ， 计 算得 到 2 次 正面 的 概率 ”根据 大 数 定律 ， 如 果 投 10000 次 ， 计 算得 到 5000 次 正面 的 概率 ? 


计算 2 次 正面 的 概率 : 


> choose (4, 2) /2^4 # choose 组合 数 的 计算 : 从 4 中 选择 2 个 
[1] 0.375 


计算 5000 次 正面 的 概率 : 


> pbinom (5000, 10000, 0.5) # pbinom 二 向 分 布 ，5000 为 分 位 数 ， 产 生 10000 个 随机 数 ， 每 个 概率 0.5 
[1] 0.5039893 


2. 中 心 极限 定理 


中 心 极限 定理 (central limit theorem). 是 判断 随机 变量 序列 部 分 和 的 分 布 是 否 渐 近 于 正 态 分 布 的 一 类 定理 。 在 自然 界 及 生产 科学 实践 中 ， 一 些 现象 受到 许多 相互 独立 的 随机 因素 的 影响 ， 如 果 每 个 因 
素 的 影响 都 很 小 ， 那 么 总 的 影响 可 以 看 做 是 服从 正 态 分 布 。 中 心 极限 定理 正 是 从 数学 上 论证 了 这 一 现象 。 设 从 均值 为 h、 方 差 为 c” (有 限 ) 的 任意 一 个 总 体 中 抽取 样本 量 为 n 的 样本 ， 则 当 n 充 分 大 时 ， 样 本 
均值 的 抽样 分 布 近似 服从 均值 为 H、 方 差 为 c2/n 的 正 态 分 布 。 两 个 最 著名 的 中 心 极限 定理 是 列 维 (Levy) 定理 和 拉 普 拉 斯 (Laplace) 定理 。 


列 维 定理 即 独立 同 分 布 随机 变量 序列 的 中 心 极限 定理 。 它 表明 ， 独 立 同 分 布 且 数学 期 望 和 方差 有 限 的 随机 变量 序列 的 标准 化 和 以 标准 正 态 分 布 为 极限 。 


设 随机 变量 X1，X2，.…Xn，.…. 相 互 独 立 ， 服 从 同一 分 布 ， 且 具有 数学 期 望 和 方差 : E (Xk) =u, D (Xk) =02>0 (k-1, 2, .) ， 则 随机 变量 之 和 的 标准 化 变量 的 分 布 函数 Fn (x) 对 于 任意 x 满足 
lim PODO, geo (x) 是 标准 正 态 分 布 的 分 布 函数 。 


拉 普 拉 斯 定理 即 服从 二 项 分 布 的 随机 变量 序列 的 中 心 极限 定理 。 它 指出 ， 参 数 为 n，p 的 二 项 分 布 以 np 为 均值 、np (1-p) 为 方差 的 正 态 分 布 为 极限 。 


P-value: 0.160 
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图 1-11 ”中心 极限 定理 动画 模拟 


R 程 序 的 中 心 极限 定理 动画 模拟 (从 指数 分 布 到 正 态 分 布 ) 如 图 1-11 所 示 。 代 码 摘自 animation 包 帮助 文档 。 


> if (! require (animation) ) install.packages ("animation") 
> library (animation) 

> ani.options (interval = 0.1, nmax = 100) 

> par (mar = c (4, 4, 1, 0.5) ) 

> clt.ani () 


掌握 R 语 言 ， 就 可 以 方便 地 运用 概率 的 知识 进行 各 种 概率 计算 ， 非 常 有 利于 帮助 我 们 解决 生活 中 遇 到 的 问题 。 


14 ”常用 连续 型 分 布 介绍 及 R 语 言 实 现 


问题 


如 何 让 R 语 言 画 出 概率 分 布 函数 曲线 ? 


5er.seegdiül: 
pngi"norm. png") 


X «- segt(-5,5, length. out -100) 
y *- dnorm{x, 9,1) 


pletí(x,y,col-"rad",vlim-c(-5, 5) ,ylim- 


XaXs-"i", yaxs-" i" ,ylab-'densit 
main-"The Normal Density Distrit 


linastx,dnorm(x,0,0. 5), col-"green") 


linestx,dnormtx,0,2),col-" blue"? 
linestx.dnormi(x,-2,13,col-" orange"? 


legend("topright",legend-paste("m-",0 -——— 
cal-c(' red", "green" ,"blue","c 


v b - ep - 
常用 连续 型 分 布 介绍 及 ” 
R 语 言 实现 


http://blog.fens.me/r-density/ 


随机 变量 在 我 们 的 生活 中 处 处 可 见 ， 如 每 日 天 气 、 股 价 涨 跌 、 彩 票 中 奖 等 ， 这 些 事情 都 是 事前 不 可 预言 其 结果 的 ， 就 算 在 相同 的 条 件 下 重复 进行 试验 ， 其 结果 未 必 相 同 。 数 学 家 们 总 结 了 这 种 规律 ， 用 
概率 分 布 来 描述 随机 变量 取 值 。 就 算 股价 不 能 预测 ， 但 如 果 知 道 了 它 的 波动 率 的 概率 分 布 ， 那 么 我 们 就 会 有 更 大 的 机 会 猜 出 答案 。 


本 节 将 介绍 用 R 语 言 画 出 多 种 连续 型 概率 分 布 的 曲线 ， 包 括 正 态 分 布 、 指 数 分 布 、 伽 玛 分 布 、 书 布尔 分 布 、F 分 布 、 工 分 布 、 贝 塔 分 布 、 卡 方 分 布 、 均 匀 分 布 。 


144 均匀 分 布 
本 节 的 系统 环境 是 : 
* Windows 7 64bit 
及: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 
均匀 分 布 (uniform distribution) 是 均匀 的 、 不 偏差 的 一 种 简单 的 概率 分 布 ， 分 为 离散 型 均匀 分 布 与 连续 型 均匀 分 布 ， 本 节 只 介绍 连续 型 的 概率 分 布 部 分 。 
1. 概 率 密度 函数 


均匀 分 布 的 概率 密度 函数 由 式 (1.13) 给 出 。 


| E 
Jüyeda-g s <b C LIS 
0, 其 他 


下 面 的 R 程 序 画 出 均匀 分 布 的 概率 密度 函数 曲线 : 


> set.seed (1) + 设置 随机 种 子 
> x<-seq (0, 10, length.out=1000) # 取 从 0~10 顺 序 取 的 1000 个 点 
> y<-dunif (x, 0, 1) + 计算 服从 均匀 分 布 0 (0, 1) ，1000 个 点 的 概率 密度 函数 的 值 
> plot (x, y, col="red", xlimec (0, 10) , ylim=c (0, 1.2) , type-'l', xaxs="i", yaxs="i", 
ylab-'density', xlab-'', main-"The Uniform Density Distribution") 
# 画 出 概率 密度 函数 曲线 ， 如 图 1-12 所 示 
> lines (x, dnorm (x, 0, 0.5) , col-"green") 4 计算 服从 均匀 分 布 U (0，0.5) 的 值 ， 并 增加 一 条 曲线 
> lines (x, dnorm (x, 0, 2) , col-"blue") + 计算 服从 均匀 分 布 U (0, 2) 的 值 ， 并 增加 一 条 曲线 
> lines (x, dnorm (x, -2, 1) , col-"orange") 3 计算 服从 均匀 分 布 U (72, 1) 的 值 ， 并 增加 一 条 曲线 
> lines (x, dnorm (x, 4, 2) ，col="purple") + 计算 服从 均匀 分 布 U (4, 2) 的 值 ， 并 增加 一 条 曲线 
> legend ("topright", legend-paste ("m=", c (0, 0, 0, -2, 2) , " sd="，c (1, 0.5, 2, 1, 2) ) , 
lwd-1, colec ("red", "green", "blue", "orange", "purple") ) # 在 右上 角 增加 图 例 
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2. 累 积分 布 函数 


均匀 分 布 的 累积 分 布 函数 公式 为 (1.14) : 


0. ux 


A 0 


pi 
Fix)- pm a&x«b ( 1.14) 
之 


ka x 


下 面 的 R 程 序 画 出 均匀 分 布 的 累积 分 布 函数 曲线 : 


> set.seed (1) + 设置 随机 种 子 

> x<-seq (0, 10, length.out=1000) # 取 从 0~10 顺 序 取 的 1000 个 点 

> y<-punif (x, 0, 1) E 计算 服从 均匀 分 布 U0 (0，1) ，1000 个 点 的 累积 分 布 函数 的 值 

> plot (x, y, col="red", xlimec (0, 10) , ylim=c (0, 1.2) , type-'l', xaxs="i", yaxs="i", 
ylab-'F (x) ', xlab-'', main-"The Uniform Cumulative Distribution Function") 
# 画 出 累积 分 布 函 数 的 曲线 ， 如 图 1-13 所 示 

> lines (x, punif (x, 0, 0.5) , col-"green") 

» lines (x, punif (x, 0, 2) , col-"blue") 

» lines (x, punif (x, -2, 1) , col-"orange") 

> legend ("bottomright", legend-paste ("m-", c (0, 0, 0, -2) , " sd=", c (1, 0.5, 2, 1) ) , 
lwd-l, col=c ("red", "green", "blue", "orange", "purple") ) 


3 .分布 检验 


Kolmogorov-Smirnov 连 续 分 布 检验 是 检验 单一 样本 是 不 是 服从 某 一 预先 假设 的 特定 分 布 的 方法 。 把 样本 数据 的 累计 频数 分 布 与 特定 理论 分 布 相 比较 ， 若 两 者 间 的 差距 很 小 ， 则 推论 该 样本 取 自 某 特定 
分 布 族 。 


均匀 分 布 检验 的 原 假设 为 Ho: 数据 集 符合 均匀 分 布 ， 备 择 假 设 为 H1: 样本 所 来 自 的 总 体 分 布 不 符合 均匀 分 布 。 令 F0 (Xx) 表示 预先 假设 的 理论 分 布 ，Fn (x) 表示 随机 样本 的 累计 概率 (频率) 函数 。 统 


计量 D 为 : 


—-max|Po(x)-F (x) 


: 了 D 值 越 小 ， 越 接近 0， 表 示 样 本 数据 越 接近 均匀 分 布 


 p 值 ， 如 果 p 值 小 于 显著 性 水 平 x (0.05) ， 则 拒绝 Ho 


> set.seed (1) # 设置 随机 种 子 

> S«-runif (1000) # 生成 服从 均匀 分 布 的 1000 点 

> ks.test (S, "punif") # Kolmogorov-Smirnov 检 验 
One-sample Kolmogorov-Smirnov test 

data: S 


D = 0.0244, p-value = 0.5928 
alternative hypothesis: two-sided 


D 值 很 小 ，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 S 符 合 均匀 分 布 ! 


后 文中 其 他 函数 的 分 布 检验 也 使 用 的 是 Kolmogorov-Smirnov 的 检验 方法 ， 因 此 后 面 检验 描述 从 略 。 
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iE (normal distribution) 又 名 高 斯 分 布 (Gaussian distribution) ， 是 一 个 在 数学 、 物 理 及 工程 等 领域 都 非常 重要 的 概率 分 布 ， 在 统计 学 的 许多 方面 有 着 重大 的 影响 力 。 


若 随机 变量 X 服 从 一 个 位 置 参数 为 h、 尺 度 参数 为 “的 高 斯 分 布 ， 则 这 个 随机 变量 就 称 为 正 态 随机 变量 ， 正 态 随机 变量 服从 的 分 布 就 称 为 正太 分布， 记 为 N (hb，a2) 。 数 学 期 望 h 决 定 了 分 布 位 置 ， 标 准 
差 o 决 定 了 分 布 的 幅度 。 因 其 曲线 呈 钟 形 ， 因 此 人 们 又 经 常 称 之 为 钟 形 曲线 。 我 们 通常 所 说 的 标准 正 态 分 布 是 u=0，o=1 的 正 态 分 布 。 


1. 概 率 密度 函数 


正 态 分 布 的 概率 密度 函数 公式 为 (1.15) : 


x-—Jquy | 
Ju) Aem exp —— ( 1.15) 


下 面 的 R 程 序 画 出 正 态 分 布 的 概率 密度 函数 曲线 : 


> set.seed (1) 

> x <- seq (-5, 5, length.out=100) # 取 从 -5 到 5 的 100 个 点 

» y <- dnorm (x, 0, 1) # 计算 服从 正 态 分 布 N (0, 1) ，100 个 点 的 概率 密度 函数 的 值 

> plot (x, y, col-"red", xlimec (-5, 5) , ylimec (0, 1) , type-'l', xaxs-"i", yaxs-"i", ylab 
-'density', xlab-'', main-"The Normal Density Distribution") 
# 画 出 概率 密度 函数 曲线 ， 如 图 1-14 所 示 

> lines (x, dnorm (x, 0, 0.5) , col-"green") 

» lines (x, dnorm (x, 0, 2) , col-"blue") 

» lines (x, dnorm (x, -2, 1) , col-"orange") 

> legend ("topright", legend-paste ("m=", c (0, 0, 0, -2) , " sd-", c (1, 0.5, 2, 1) ) ， 1wd-1, 


colec ("red", "green", "blue", "orange") ) 
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The Normal Cumulative Distribution 
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图 1-15 正 态 分 布 的 概率 密度 函数 图 


2. 累 积分 布 函数 


正 态 分 布 的 概率 密度 函数 公式 为 (1.16) : 


的 CLIE) 
F(x; 4,0) = oan | exp DT d 


"FIEBS RES FEIEIEHTE S A Tp BERE fb ERES: : 


> set.seed (1) 

> x <- seq (-5, 5, length.out-100) 

> y <- pnorm (x, 0, 1) # 计算 服从 正 态 分 布 N (0, 1) ，100 个 点 的 累积 分 布 函 数 的 值 

> plot (x, y, col-"red", xlimec (-5, 5) , ylimec (0, 1) , type-'l', xaxs-"i", yaxs-"i", 
ylab-'F (x) ', xlab-'', main-"The Normal Cumulative Distribution") 
E 画 出 累积 分 布 函 数 曲 线 ， 如 图 1-15 所 示 

> lines (x, pnorm (x, 0, 0.5) , col-"green") 

» lines (x, pnorm (x, 0, 2) , col-"blue") 

» lines (x, pnorm (x, -2, 1) , col-"orange") 


> legend ("bottomright", legend-paste ("m-", c (0, 0, 0, -2) , " sd-", c (1, 0.5, 2, 1) ) , 
lwd-1, colec ("red", "green", "blue", "orange") ) 
3 .分布 检验 


Shapiro-Wik 正 态 分 布 检验 用 来 检验 数据 是 否 符合 正 态 分 布 ， 同 线性 回归 的 方法 一 样 ， 是 检验 其 与 回归 曲线 的 残 差 。 该 方法 推荐 在 样本 量 很 小 的 时 候 使 用 ， 一 般 是 样本 在 3~5000 之 间 。 


Shapiro-Wik 正 态 分 布 检验 的 原 假设 为 Ho: 数据 集 符合 正 态 分 布 ， 统 计量 W 为 


了 


一 


E; 
> di Xii 


ELI 
7 


W = 


i71 


其 中 统计 量 W 最 大 值 是 1， 越 接近 1， 表 示 样 本 与 正 态 分 布 越 


匹配 。 如 果 p 值 小 于 显著 性 水 平 c (0.05) ， 则 拒绝 Ho 


( 1.17) 


> set.seed (1) 
» S«-rnorm (1000) 
> shapiro.test (S) 

Shapiro-Wilk normality test 
data: S 
W = 0.9988, 


# 生成 服从 正 态 分 布 的 1000 点 


p-value = 0.7256 


# Shapiro-Wilk 正 态 分 布 检验 


这 里 W 接 近 1，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 S 符 合 正 态 分 布 ! 


E 


Kolmogorov-Smirnov 连 续 分 布 检验 ， 原 假设 为 H0: 数据 集 符合 正 态 分 布 ， 备 择 假设 为 H1: 样本 所 来 自 


的 总 体 分 布 不 符合 正 态 分 布 。 


> set.seed (1) 

> S«-rnorm (1000) 

» ks.test (S, "pnorm") # Kolmogorov-Smirnovif Je 
One-sample Kolmogorov-Smirnov test 

data: S 

D = 0.0211, p-value = 0.7673 

alternative hypothesis: two-sided 


这 里 D 值 很 小 ，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 S 符 合 正 态 分 布 ! 


143 ”指数 分 布 


指数 分 布 (exponential distribution) 用 来 表示 独立 随机 习 
统 的 寿命 分 布 也 可 
x 


1. 概 率 密度 函数 


指数 分 布 的 概率 密度 函数 公式 为 (1.18) : 


fx;4 ) = 0 


Ae^, x20 
x«0 


HRERS, EARE, rPICHEREENRUNTAS EUH 
指数 分 布 来 近似 。 当 产品 的 失效 是 偶然 失效 时 ， 其 寿命 服从 指数 分 布 。 指 数 分 布 的 失效 率 是 与 时 间 t 无 关 的 常数 ， 所 以 分 布 函数 简单 。 指 数 分 布 在 可 靠 性 研究 中 是 最 常 


其 中 人 > 0 是 分 布 的 参数 ， 常 被 称 为 率 参 数 (rate parameter) ， 即 每 和 


和 位 时 间 发 生 该 二 


下 面 的 R 程 序 画 出 指数 分 布 的 概率 密 


件 的 次 数 。 指 数 分 布 的 取 值 


现 的 时 间 间 隔 等 。 许 多 电子 产品 的 寿命 一 般 服 从 指数 分 布 ， 有 的 系 


的 一 种 分 布 形 


( 1.18) 


区 间 是 [0，co) 。 如 果 一 个 随机 变量 X 呈 指数 分 布 ， 则 可 以 写作 X~Exponential (A) 。 


> set.seed (1) 

> x«-seq (-1, 2, length.out-100 

» y«-dexp (x, 0.5) # 

> plot (x, y, col="red", xlimec (0, 2) , ylim=c (0, 5) 
'density', xlab-'', main-"The Exponential Density Dist 
# 画 出 概率 密度 函数 曲线 ， 如 图 1-16 所 示 

> lines (x, dexp (x, 1) , col-"green") 

> lines (x, dexp (x, 2) , col-"blue") 

» lines (x, dexp (x, 5) , col-"orange") 

> legend ("topright", legend-paste ("rate-", c (.5, 
"green", "blue", "orange") ) 


1, 2, 


) 
计算 服从 指数 分 布 e (0.5) ，100 个 点 的 概率 密 
, type-'l', 


xaxs-"i 
ribution") 


5)), lwd=1， 


colec ("red", 
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指数 分 布 的 累积 分 布 函数 公式 为 (1.19) : 


ox f1-6e*, x20 
fix 4) = 0. x«0 


下 面 的 R 程 序 画 出 指数 分 布 的 累积 分 布 函数 曲线 。 


20 


( 1.19 J 


» set.seed (1) 

» x«-seq (-1, 2, length.out-100) 

» y«-pexp (x, 0.5) # 计算 服从 指数 分 布 e (0.5) ，100 个 点 的 累积 分 布 函 数 的 值 

> plot (x, y, col-"red", xlimec (0, 2) , ylimec (0, 1) , type-'l', xaxs-"i", yaxs-"i", ylab- 
'F (x) ', xlab-'', main-"The Exponential Cumulative Distribution Function") 
# 画 出 累积 分 布 函 数 曲 线 ， 如 图 1-17 所 示 

> lines (x, pexp (x, 1) , col-"green") 

> lines (x, pexp (x, 2) , col-"blue") 

» lines (x, pexp (x, 5) , col-"orange") 

> legend ("bottomright", legend-paste ("rate-", c (.5, 1, 2, 5)) , lwd-l, col=c ("red", 
"green", "blue", "orange") ) 


3. 分 布 检验 


对 指数 分 布 来 说 ，Kolmogorov-Smirnov 连 续 分 布 检验 的 原 假设 为 Ho: 数据 集 符合 指数 分 布 ， 备 择 假设 为 H1: 样本 所 来 自 的 总 体 分 布 不 符合 指数 分 布 。 


> set.seed (1) 
> S«-rexp (1000) 


> ks.test (S, "pexp") 4 Kolmogorov-Smirnovit JE 
One-sample Kolmogorov-Smirnov test 
data: S 


D = 0.0387, p-value = 0.1001 
alternative hypothesis: two-sided 


这 里 ，D 值 很 小 ，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 S 符 合 指数 分 布 ! 
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MBAH (Gamma) FEARREN ENDRA R RER— R, MORRAS. CAIN 


lays i Perd 


1. 概 率 密度 函数 


件 玛 分 布 的 概率 密度 函数 公式 为 (1.21) : 


fx 


其 中 为 形状 参数 ，6 为 


[ 


-x 


e 


[D (k) 0" 


TES: 


下 面 的 R 程 序 画 出 伽 玛 分 布 的 概率 密 


度 函 数 曲线 。 


线 有 一 个 峰 ， 但 左右 不 对 称 。 伽 玛 函 数 是 阶乘 在 实数 上 的 泛 化 ， 其 公式 为 (1.20) : 


( 1.20) 


( 1.21) 


set.seed (1) 
x«-seq (0, 10, length.out-100) 
y«-dgamma (x, 1, 2) 
plot (x, y, col-"red", xlimec (0, 10) , ylimec (0, 2) , type-'l', xaxs- 
'density', xlab-'', main-"The Gamma Density Distribution") 
# 画 出 概率 密度 函数 曲线 ， 如 图 1-18 所 示 
lines (x, dgamma (x, 2, reen") 
lines (x, dgamma (x, 3, 
lines (x, dgamma (x, 5, 
lines (x, dgamma (x, 9, " 
legend ("topright", legend-paste ("shape-", c (1, 2, 3, 5, 9) , " rate-", 
lwd-1, col=c ("red", "green", "blue", "orange", "black") ) 


+ HIRA Ga (1, 2) ，100 个 点 的 概率 密度 函数 的 值 


Vvvv 


, yaxs-"i", 


Vvvvyv 


& (2, 2, 2, 1, 


ylab- 


D S 


2. 累 积分 布 函数 


伽 玛 分 布 的 累积 分 布 函数 公式 为 (1.22) : 


y (k,x/0) 
| (k) 


下 面 的 R 程 序 画 出 伽 玛 分 布 的 累积 分 布 函数 曲线 。 


F(x) = 


(1.22) 


set.seed (1) 

x«-seq (0, 10, length.out-100) 

y«-pgamma (x, 1, 2) + 计算 服从 伽 玛 分 布 Ga (1, 2) ，100 个 点 的 累积 分 布 

plot (x, y, col-"red", xlimec (0, 10) , ylimec (0, 1) , type-'l', xaxs-"i", 
'F (x) ', xlab-'', main-"The Gamma Cumulative Distribution Function") 
# 画 出 累积 分 布 函 数 曲 线 ， 如 图 1-19 所 示 

lines (x, pgamma (x, 2, 2) , col- 

lines (x, pgamma (x, 3, 2) , col- 

lines (x, pgamma (x, 5, 1) , col-"orange") 

lines (x, pgamma (x, 9, 1) , col-"black") 

legend ("bottomright", legend-paste ("shape-", 
c(2,2,2, 1, 1 ) , 1wd-l, colec ("red", 


Vvvyv 


yaxs-"i", 


VVVVN 


c(1,2, 3, 5, 9) , " rate-", 
"green", "blue", "orange", "black") ) 
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3. 分 布 检验 


shape- 1 rate- 2 
shape- 2 rate- 2 
shape- 3 rate- 2 
shape- 5 rate- 1 
shape- 9 rate- 1 


10 


对 伽 玛 分 布 来 说，Kolmogorov-Smirnov 连 续 分 布 检验 的 原 假设 为 H0: 数据 集 符合 伽 玛 分 布 ， 备 择 假 设 为 H1: 样本 所 来 自 的 总 体 分 布 不 符合 伽 玛 分 布 。 


> set.seed (1) 
» S«-rgamma (1000, 1) 
» ks.test (S, "pgamma", 1) 

One-sample Kolmogorov-Smirnov test 
data: S 
D = 0.0363, 
alternative hypothesis: 


# Kolmogorov-Smirnov4t Je 


p-value - 0.1438 
two-sided 


这 里 D 值 很 小 ，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 S 符 合 形状 参数 为 1 仰 玛 分 布 ! 


下 面 我 们 做 一 个 检验 失败 的 测试 ， 如 果 设 检验 形状 参数 为 2， 那 么 


Kolmogorov-Smirnov 检 验 时 ， 


结果 就 不 是 符合 我 们 预期 的 。 


> ks.test (S, "pgamma", 2) # Kolmogorov-Smirnov 检 验 
One-sample Kolmogorov-Smirnov test 

data: S 

D = 0.3801, 

alternative hypothesis: 


p-value « 2.2e-16 
two-sided 


这 里 D 值 不 够 小 ，p 值 <0.05， 拒 绝 原 假设 ， 所 以 数据 集 S 不 符合 形状 参数 为 2 伽 玛 分 布 ! 


1.4.5” 韦 布尔 分 布 


布尔 分 布 由 形状 、 尺 度 ( 范 辕 


韦 布 尔 (Weibul) 分 布 ， 又 称 韦 氏 分 布 或 韦伯 分 布 ， 是 可 靠 性 分 析 和 寿命 检验 的 理论 基础 。 
的 基本 形状 ， 尺 度 参 数 起 放大 或 缩小 曲线 的 作用 ， 但 不 影响 分 布 的 形状 。 


韦 布 尔 分 布 通常 


“一直 为 常量 (constant overtime) ,那么 x=1， 上 暗示 在 随机 事件 中 发 生 ; 


) 和 位 置 三 个 参数 决定 


在 故障 分 析 领 域 中 ; 尤其 是 它 可 以 模拟 故障 率 (failture rate) 持续 变化 的 分 布 。 如 果 故 障 率 : 


， 其 中 形状 参数 是 最 重要 的 参数 ， 决 定 分 布 密度 


- 一 直 减 少 (decreases overtime) ， 那 么 x<1， 上 暗示 “早期 失效 (infant mortality) " ; 
一直 增加 (increases overtime) ， 那 么 g>1， 瞳 示 “ 耗 尽 (wearout) ”， 即 随 着 时 间 的 推进 ， 失 败 的 可 能 性 变 大 。 


1. 概 率 密度 函数 


韦 布尔 分 布 的 概率 密度 函数 公式 为 (1.23) : 


X X KCl got Ss 
Absa € 2-990 (123) 
0, r« 0 


下 面 的 R 程 序 画 出 韦 布尔 分 布 的 概率 密度 函数 曲线 。 


set.seed (1) 

x<- seq (0, 2.5, length.out=1000) 

y<- dweibull (x, 0.5) # 计算 服从 韦 布 尔 分 布 W (0.5, 1) ，1000 个 点 的 概率 密度 函数 的 值 

plot (x, y, type-"l", col-"blue", xlimec (0, 2. 5) $ ylim-c (0, 6) , xaxs-"i", yaxs- 
"i", ylab-'density', xlab-'', main-"The Weibull Density Distribution") 
# rrr err bod 2 


Vvvv 


> lines (x, dweibull (x, ， Col="red") 

> lines (x, dweibull (x, ， Col="magenta") 

> lines (x, dweibull (x, ， Col="green") 

> lines (x, dweibull (x, 15), type ", col-"purple") 

> legend ("topright", legend-paste ("shape =", c (.5, 1, 1.5, 5, 15)), 
lwd=1, colec ("blue", "red", "magenta", "green", "purple") ) 

2. 累 积分 布 函数 


布尔 分 布 的 累积 分 布 阔 数 公 式 为 (1.24) : 


F(xX) 51-e' €» ( 1.24) 


下 面 的 R 程 序 画 出 韦 布尔 分 布 的 累积 分 布 函数 曲线 。 


set.seed (1) 

x<- seq (0, 2.5, length.out-1000) 

y<- pweibull (x, 0.5) # 计算 服从 weibul1 分 布 W (0.5, 1) ，1000 个 点 的 累积 分 布 函数 的 值 

plot (x, y, type-"l", col-"blue", xlimec (0, 2.5), ylim-c (0, 1.2) , xaxs- » 
"i", ylab-'F (x) ', xlab-'', main-"The Weibull Cumulative Distribution Function") 
r 画 出 累积 分 布 函 教 曲线 ， 如 图 1-21 所 

lines (x, pweibull (x, 1) , type- 

lines (x, pweibull (x, 1.5) , typ 

lines (x, pweibull (x, 5) , type- col-"green") 

lines (x, pweibull (x, 15) , type col-"purple") 

legend ("bottomright", legend-paste (" "shape. 5 €(5, 1, 1.5, 5, 15)), indl, 
colec ("blue", "red", "magenta", "green", "purple") ) 


Vvvyv 


yaxs- 


， Col="red") 
， Col="magenta") 


VVVVN 
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3. 分 布 检验 


对 于 韦 布 尔 分 布 ，Kolmogorov-Smirnov 连 续 分 布 检验 的 原 假设 为 Ho: 数据 集 符合 韦 布尔 分 布 ， 备 择 假设 为 H1: 样本 所 来 自 的 总 体 分 布 不 符合 韦 布 尔 分 布 。 


> set.seed (1 

> S«-rweibull (1000, 1) 

» ks.test (S, "pweibull", 1) 4 Kolmogorov-Smirnovi& Jr 
One-sample Kolmogorov-Smirnov test 

data: 

D = 0.0244, p-value = 0.5928 

alternative hypothesis: two-sided 


这 里 D 值 很 小 ，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 S 符 合 形状 参数 为 1 的 韦 布尔 分 布 ! 


146 卡 方 分 布 


若 n 个 相互 独立 的 随机 变量 51，52，…，En 均 服从 标准 正 态 分 布 (也 称 独立 同 分 布 于 标准 正 态 分 布 ) ， 则 这 n 个 服从 标准 正 态 分 布 的 随机 变量 的 平方 和 构成 一 个 新 的 随机 变量 ， 其 分 布 规律 称 为 卡 方 
(XÊ, chi-square) 分 布 。 其 中 参数 n 称 为 自由 度 ， 自 由 度 不 同 就 是 另 一 个 卡 方 分 布 ， 正 如 正 态 分 布 中 均值 或 方差 不 同 就 是 另 一 个 正 态 分 布 一 样 。 


1. 概 率 密度 函数 


(2 k/2-1 -=x 
ix) 5D ' 
0, x«O0 


( 1.25) 


R 


其 中 分 母 [是 伽 玛 函 数 。 


下 面 是 R 程 序 画 出 卡 方 分 布 的 概率 密度 函数 曲线 。 


Œ| 


set.seed (1) 

x<-seq (0, 10, length.out=1000) 

y<-dchisq (x, 1) + 计算 服从 卡 方 分 布 X (1) ，1000 个 点 的 概率 密度 函数 的 值 

plot (x, y, col-"red", xlimec (0, 5) , ylimec (0, 2) , type-'l', xaxs-"i", yaxs-"i", ylab- 
'density', xlab-'', main-"The Chisq Density Distribution") 
# 画 出 概率 密度 函数 曲线 ， 如 图 1-22 所 示 

lines (x, dchisq (x, 2) , col-"green") 

lines (x, dchisq (x, 3) , col-"blue") 

lines (x, dchisq (x, 10) , col-"orange") 

legend ("topright", legend-paste ("df-", c (1, 2, 3, 10) ) , lwd=1， col=c ("red", 
"green", "blue", "orange") ) 


Vvvyv 


Vvvv 


2. 累 积分 布 函数 


卡 方 分 布 的 累积 分 布 函数 公式 为 (1.26) : 


Y (k/2,x/2) ( 1.26 ) 
D (k/2) 


其 中 分 母 [是 仰 玛 函 数 ， 分 子 Y (k, z) 为 不 完全 伽 玛 函 数 。 


R(x) = 


下 面 的 R 程 序 画 出 卡 方 分 布 的 累积 分 布 函数 曲线 。 


set.seed (1) 

x«-seq (0, 10, length.out-1000) 

y«-pchisq (x, 1) d 计算 服从 卡 方 分 布 X (1) ，1000 个 点 的 累积 分 布 函数 的 值 

plot (x, y, col-"red", xlimec (0, 10) , ylimec (0, 1) , type-'l', xaxs-"i", yaxs-"i", ylab- 
'F (x) ', xlab-'', main-"The Chisq Cumulative Distribution Function") 
# 画 出 累积 分 布 函数 曲线 ， 如 图 1-23 所 示 

lines (x, pchisq (x, 2) , col-"green") 

lines (x, pchisq (x, 3) , col-"blue") 

lines (x, pchisq (x, 10) , col-"orange") 

legend ("topleft", legend-paste ("df-", c (1, 2, 3, 10) ) , lwd-l, col=c ("red", "green", 
"blue", "orange") ) 


Vvvv 


Vvvv 
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The Chisq Cumulative Distribution Function 
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图 1-23” 卡 方 分 布 的 累积 分 布 函 数 图 
3. 分 布 检验 


对 于 卡 方 分 布 ，Kolmogorov-Smirnov 连 续 分 布 检验 的 原 假设 为 Ho: 数据 集 符合 卡 方 分 布 ， 备 择 假 设 为 H1: 样本 所 来 自 的 总 体 分 布 不 符合 卡 方 分 布 。 


> set.seed (1) 

» S«-rchisq (1000, 1) 

» ks.test (S, "pchisq", 1) # Kolmogorov-Smirnov 检 验 
One-sample Kolmogorov-Smirnov test 

data: 

D = 0.0254, p-value = 0.5385 

alternative hypothesis: two-sided 


这 里 D 值 很 小 ，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 S 符 合 自由 度 为 1 的 卡 方 分 布 ! 


144 F 分 布 


F 分 布 是 一 种 连续 型 概率 分 布 ， 广 泛 应 用 于 似 然 比率 检验 ， 特 别 是 ANOVA 中 。F 分 布 的 定义 为 : 设 X，Y 为 两 个 独立 的 随机 变量 ，X 服 从 自由 度 为 d1 的 卡 方 分 布 ，Y 服 从 自由 度 为 d2 的 卡 方 分 布 ， 则 


F= Xd, 
Y/d: 服从 自由 度 为 d1 和 d2 的 F 分 布 。 


F 分 布 是 一 种 非 对 称 分 布 ， 它 有 两 个 自由 度 ， 即 d1 和 d2， 相 应 的 分 布 记 为 F (di, do) ，d1 通 常 称 为 分 子 自由 度 ，d2 通 常 称 为 分 母 自由 度 。F 分 布 是 一 个 以 自由 度 d1 和 dz 为 参数 的 分 布 族 ， 不 同 的 自由 
度 决 定 了 F 分 布 的 形状 。 
1. 概 率 密度 函数 


F 分 布 的 概率 密度 函数 公式 为 (1.27) : 


TI ((di + d)/2) (4 f a ( i d, PT 


l (4/2) (d./2) Nd; T n (127) 


Fx d s d.) 一 


其 中 [是 伽 玛 函数 。 


下 面 的 R 程 序 画 出 F 分 布 的 概率 密度 函数 曲线 。 


set.seed (1) 

x«-seq (0, 5, length.out-1000) 

y«-df (x, 1, 1, 0) # 计算 服从 F 分 布 F (1, 1, 0) ，1000 个 点 的 概率 密度 函数 的 值 

plot (x, y, cole"red", xlim-c (0, 5) , ylim=c (0, 1) , type-'l', xaxs yaxs-"i", ylab- 
'density', xlab-'', main-"The F Density Distribution") 
# 画 出 概率 密度 函数 曲线 ， 如 图 1-24 所 示 

lines (x, df (x, 1, 1, 2) , col-"green") 

lines (x, df (x, 2, 2, 2) , col-"blue") 

lines (x, df (x, 2, 4, 4) , col-"orange") 

legend ("topright", legend-paste ("dfl-", c (1, 1, 2, 2) , "df2-", c (1, 1, 2, 4) , " ncp-", 
c (0, 2, 2, 4 ) , lwd-l, col=c ("red", "green", "blue", "orange") ) 


Vvvyv 


Vvvv 


2. 累 积分 布 函数 


J= ax (4/2, d./2) (1.28) 


其 中 | 是 不 完全 Beta 函 数 


下 面 的 R 程 序 画 出 F 分 布 的 累积 分 布 函数 曲线 。 


> set.seed (1) 

> x«-seq (0, 5, length.out-1000) 

> y«-df (x, 1, 1, 0) # 计算 服从 F 分 布 F (1, 1, 0) ，1000 个 点 的 累积 分 布 函数 的 值 

> plot (x, y, col-"red", xlimec (0, 5) , ylim=c (0, 1) , type-'l', xaxs-"i", yaxs-"i", ylab- 
'F (x) ', xlab-'', main-"The F Cumulative Distribution Function") 
# 画 出 累积 分 布 函 数 曲 线 ， 如 图 1-25 所 示 

> lines (x, pf (x, 1, 1, 2) , col-"green") 

» lines (x, pf (x, 2, 2, 2) , col-"blue") 

» lines (x, pf (x, 2, 4, 4) , col-"orange") 

> legend ("topright", legend-paste ("dfl-", c (1, 1, 2, 2) , "df2-", c (1, 1, 2, 4) , " nop-", 


c (0, 2, 2, 4) ) , lwd-l, col=c ("red", "green", "blue", "orange") ) 


The F Density Distribution 
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3. 分 布 检验 


对 于 F 分 布 ，Kolmogorov-Smirnov 连 续 分 布 检验 的 原 假设 为 Ho: 数据 集 符合 F 分 布 ， 备 择 假设 为 H1: 样本 所 来 自 的 总 体 分 布 不 符合 F 分 布 。 


> set.seed (1) 
> S«-rf (1000, 1, 1, 2) 


» ks.test (S, "pf", 1, 1, 2) # Kolmogorov-Smirnov4t Jr 
One-sample Kolmogorov-Smirnov test 
data: S 


D = 0.0113, p-value = 0.9996 
alternative hypothesis: two-sided 


这 里 D 值 很 小 ，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 5 符 合 df1=1，df2=1，ncp=2 的 F 分 布 ! 


148 tfo 


学 生 t 分 布 (Student' st-Distribution) ， 可 简称 为 {分 布 ， 应 用 于 估计 呈正 态 分 布 的 总 体 之 平均 数 。 它 是 对 两 个 样本 均值 差异 进行 显著 性 测试 的 学 生 t 检 验 的 基础 。 学 生 t 检 验 改 进 了 7 检验 (Z- 
test) ， 因 为 Z 检 验 以 总 体 标准 差 已 知 为 前 提 。 虽 然 在 样本 数量 大 (超过 30 个 ) 时 ， 可 以 应 用 Z 检 验 来 求 得 近似 值 ， 但 Z 检 验 用 在 小 样本 会 产生 很 大 的 误差 ， 因 此 必须 改 用 学 生 t 检 验 以 求 准确 。 


1. 概 率 密度 函数 


t 分 布 的 概率 密度 函数 公式 为 


| l'(v*1)2 
Ji (er 19724) (1.29) 


Vyn T (v2) (1 * x* |y)? 


其 中 v 等 于 n-1， 一 般 称 为 自由 度 ; TEMBR. 


下 面 的 R 程 序 画 出 t 分 布 的 概率 密度 函数 曲线 。 


> set.seed (1) 

» x«-seq (-5, 5, length.out-1000) 

> y«-dt (x, 1, 0) # 计算 服从 tt 分布 T (1, 0) ，1000 个 点 的 概率 密度 函数 的 值 

> plot (x, y, col-"red", xlimec (-5, 5) , ylimec (0, 0.5) , type-'l', xaxs-"i", yaxs-"i", ylab 
-'density', xlab-'', main-"The T Density Distribution") 
# 画 出 概率 密度 函数 曲线 ， 如 图 1-26 所 示 

> lines (x, dt (x, 5, 0) , col-"green") 

> lines (x, dt (x, 5, 2) , col-"blue") 

» lines (x, dt (x, 50, 4) , col-"orange") 

> legend ("topleft", legend-paste ("df-", c (1, 5, 5, 50) , " ncp-", c (0, 0, 2, 4) ) , lwd=1, 
colec ("red", "green", "blue", "orange") ) 

2. 累 积分 布 函数 


t 纷 布 的 累积 分 布 函数 公式 为 (1.30) : 


2 
X 


xI' ((v * 1)/25;R Ts 2:3: T ( 1.30) 
F(x) = 二 + < 
2 Jxv E (y/2) 


其 中 v 等 于 n-1， 一 般 称 为 自由 度 ; TEMBR. 


下 面 的 R 程 序 画 出 t 分 布 的 累积 分 布 函数 曲线 。 


> set.seed (1) 

» x«-seq (-5, 5, length.out-1000) 

> y«-pt (x, 1, 0) # 计算 服从 T 分 布 T (1, 0) ，1000 个 点 的 累积 分 布 函数 的 值 

> plot (x, y, col-"red", xlimec (-5, 5) , ylimec (0, 0.5) , type-'l', xaxs-"i", yaxs="i", ylab 
='F (x) ', xlab-'', main-"The T Cumulative Distribution Function") 
E 通 出 累积 分 布 函 数 曲 线 ， 如 图 1-27 所 示 

> lines (x, pt (x, 5, 0) , co reen") 

> lines (x, pt (x, 5, 2) , col-"blue") 

» lines (x, pt (x, 50, 4) , col-"orange") 

> legend ("topleft", legend-paste ("df-", c (1, 5, 5, 50) , " ncp-", c (0, 0, 2, 4) ) , lwd=1, 


colec ("red", "green", "blue", "orange") ) 
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3 .分布 检验 


对 于 {分布 ，Kolmogorov-Smirnov 连 续 分 布 检验 的 原 假设 为 Ho: 数据 集 符合 t 分 布 ， 备 择 假设 为 H1: 样本 所 来 自 的 总 体 分 布 不 符合 t 分 布 。 


> set.seed (1) 
> S«-rt (1000, 1, 2) 


> ks.test (S, "pt", 1, 2) # Kolmogorov-Smirnovit Je 
One-sample Kolmogorov-Smirnov test 
data: S 


D = 0.0253, p-value = 0.5461 
alternative hypothesis: two-sided 


这 里 D 值 很 小 ，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 S 符 合 df=1，ncp=2 的 t 分 布 ! 


149 ”贝塔 分 布 


贝塔 (Beta) 分 布 是 指 一 组 定义 在 (0，1) 区 间 的 连续 概率 分 布 ，Beta 分 布 有 a 和 B 两 个 参数 ，a，B>0， 其 中 0 为 成 功 次 数 加 1，B 为 失败 次 数 加 1。 


贝塔 分 布 通常 用 来 为 取 值 于 某 有 限 区 间 [c，d] 的 随机 现象 建立 模型 。 当 然 ， 如 果 令 c 为 原点 ， 而 d-c 为 单位 长 度 ， 那 么 可 将 取 值 区 间 转 化 为 [0，1]。 贝 塔 分 布 的 一 个 重要 应 用 是 作为 伯 努 利 分 布 和 二 项 式 分 
布 的 共 二 先 验 分 布 出 现 ， 在 机 器 学 习 和 数理 统计 学 中 有 重要 应 用 。 


1. 概 率 密度 函数 


概率 密度 函数 公式 为 (1.31) : 


Y NON "- x“ (1 = i - D (a * B) 40-1 BT c l .a-1 NB 
f(x: a. B) NETS Lay as POT QU- = 0-9 CLS) 


其 中 随机 变量 X 服 从 参数 为 x，B 的 贝塔 分 布 ，[ 是 伽 玛 函 数 


下 面 的 R 程 序 画 出 贝塔 分 布 的 概率 密度 函数 曲线 。 


> set.seed (1) 

» x«-seq (-5, 5, length.out-10000) 

» y«-dbeta (x, 0.5, 0.5) + 计算 服从 贝塔 分 布 B (0.5，0.5) ，10000 个 点 的 概率 密度 函数 的 值 

> plot (x, y, col="red", xlim=c (0, 1) , ylim=c (0, 6) , type-'l', xaxs-"i", yaxs-"i", ylab- 


'density', xlab-'', main-"The Beta Density Distribution") 
+ 画 出 概率 密度 函数 曲线 ， 如 图 1-28 所 示 


> lines (x, dbeta (x, 5, 1) , col-"green") 

» lines (x, dbeta (x, 1, 3) , col-"blue") 

» lines (x, dbeta (x, 2, 2) , col-"orange") 

» lines (x, dbeta (x, 2, 5) , col-"black") 

> legend ("top", legend-paste ("a=", c (.5, 5, 1, 2, 2) , " b=", c (.5,1, 3, 2, 5 ) , lwd=1， 
col=c ("red", "green", "blue", "orange", "black") ) 

2. 累 积分 布 函数 


贝塔 分 布 的 累积 分 布 函数 公式 为 (1.32) : 


Bin. | 
F(x;a, B) = AA - [,(a, B) 


其 中 B 是 正则 不 完全 贝塔 函数 。 


下 面 的 R 程 序 画 出 贝塔 分 布 的 累积 分 布 函数 曲线 。 


( 1.32) 


» set.seed (1) 

» x«-seq (-5, 5, length.out-10000) 

» y«-pbeta (x, 0.5, 0.5) E 计算 服从 贝塔 分 布 B (0.5, 0.5) ，10000 个 点 的 累积 分 布 函 数 的 值 

> plot (x, y, col-"red", xlimec (0, 1) , ylimec (0, 1) , type-'l', xaxs ', yaxs-"i", ylab- 


'F (x) ', xlab-'', main-"The Beta Cumulative Distribution Function") 
# 画 出 累积 分 布 函数 曲线 ， 如 图 1-29 所 示 

lines (x, pbeta (x, 5, 1) , col-"green") 

lines (x, pbeta (x, 1, 3) , col-"blue") 

lines (x, pbeta (x, 2, 2) , col-"orange") 

lines (x, pbeta (x, 2, 5) , col-"black") 

legend ("topleft", legend-paste ("a-", c (.5, 5, 1, 2, 2 , " b=", c (.5,1, 3, 2, 5 ) , lwd=1， 
colec ("red", "green", "blue", "orange", "black") ) 
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3. 分 布 检验 


对 于 贝塔 分 布 ，Kolmogorov-Smirnov 连 续 分 布 检验 的 原 假设 为 Ho: 数据 集 符合 贝塔 分 布 ， 备 择 假 设 为 H1: 样本 所 来 自 的 总 体 分 布 不 符合 贝塔 分 布 。 


The Beta Cumulative Distribution Function 
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图 1-29 ”贝塔 分 布 的 累积 分 布 函 数 图 
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» set.seed (1) 
» S«-rbeta (1000, 1, 2) 
» ks.test (S, "pbeta", 1, 2) 


# Kolmogorov-Smirnovi$ Jr 


One-sample Kolmogorov-Smirnov test 


data: S 
D = 0.0202, p-value = 0.807 


alternative hypothesis: two-sided 


这 里 D 值 很 小 ，p 值 >0.05， 不 能 拒绝 原 假设 ， 所 以 数据 集 S 符 合 形状 参数 为 1 和 2 的 贝塔 分 布 ! 


在 掌握 了 这 几 种 常用 的 连续 型 分 布 后 ， 我 们 就 可 以 基于 这 些 分 布 来 建 模 了 ， 很 多 算法 模型 也 就 能 解释 通 了 ! 最 后 说 明 一 点 ， 本 书 不 是 统计 学 方面 的 教科 书 ， 对 每 种 分 布 的 定义 均 摘自 互联 网 ， 与 教科 书 


有 出 入 的 部 分 请 以 统计 学 教科 书 为 准 。 


1.5”R 语 言 的 导数 计算 
问题 


如 何 用 RR 语言 进行 导数 计算 ? 


AR 语言 的 导数 计算 


] httpy/blog.fens.me/r-math-derivative/ 


(reges 


i ir 
H 


高 等 数学 是 每 个 大 学 生 都 要 学 习 的 一 门 数 学 基础 课 ， 同 时 也 可 能 是 考 完 试 后 最 容易 忘记 的 一 门 知识 。 我 在 学 习 高 数 的 时 候 绞 尽 脑汁 ， 但 始终 都 不 知道 为 何 而 学 ， 生 活 和 工作 基本 用 不 到 ， 就 算是 在 计算 


机 行业 和 金融 行业 ， 能 直接 用 到 高 数 的 地 方 也 少 之 又 少 ， 学 术 和 实际 应 用 真是 相差 太 远 了 。 


不 过 ， 有 语言 为 我 打开 了 一 扇 高 数 应 用 的 大 门 ，R 语 言 不 仅 能 方便 地 实现 高 等 数学 的 计算 ， 还 可 以 很 容易 地 把 一 篇 论文 中 的 高 数 公 式 应 用 于 产品 的 实践 中 。 因 为 R 语 言 我 重新 学 习 了 高 数 ， 让 生活 中 充满 
数学 ， 生 活 会 变 得 更 有 意思 。 本 节 并 不 是 完整 的 高 数 计算 手册 ， 仅 介绍 了 导数 计算 和 偏 导 数 计算 的 R 语 言 实现 。 


151 ”导数 计算 


导数 (derivative) 是 微分 学 的 基本 概念 ， 其 定义 为 ， 若 函数 y=f (x) 在 x 的 某 个 邻 域内 有 定义 ， 当 自 变量 x 在 xo 处 取得 增加 Ax (点 xo+Ax 仍 在 该 邻 域 内 ) 时 ， 相 应 的 函数 取得 增 量 Ay=f (xo*Ax) - 
f (xo) ; 如 果 Ay 与 Ax 之 比 当 Ax 趋 于 0 时 的 极限 存在 ， 则 称 函 数 y=f (x) 在 点 x0 处 可 导 ， 并 称 这 个 极限 为 函数 y=f (x) 在 点 x0 处 的 导数 ， 记 为 f (xo) ， 即 


, , Ay ; (x t Ax - (Xo 
f x)= lim E lim Je 一 Je) ( 1.33) 


Ax —0 


thigte? bo . dy/dx|. 0 或 WX)/ dx =r 


通过 R 语 言 可 以 使 用 deriv () 函数 直接 进行 导数 的 计算 ， 比 如 要 计算 y=x3 的 导数 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 y=3x2， 当 x=1 时 ，yY =3， 当 x=2 时 ，yY=12。 


本 节 的 系统 环境 是 : 
* Windows 7 64bit 


- R: 3.1.1 x86. 64-w64-mingw32/x64 (64-bit) 


R 语 言 程序 实现 导数 计算 ， 代 码 如 下 。 


> dx <- deriv (y ~ x^3, "x") ; dx # 生成 导数 公式 

expression ({ 
.value «- x^3 
.grad <- array (0, c (length (.value) , 1L), list (NULL, c ("x") ) ) 
gradi, "x"] <- 3 * x^2 


attr (.value, "gradient") «- .grad 
.Value 
p 
» mode (dx) 
1] "expression" 
» x«-1:2 tá 
> eval (dx) LÀ 
1118 # 原 函 数 的 计算 结果 
attr (, "gradient") # 使 用 梯度 下 降 法 ， 寻 函数 的 计算 结果 
x 

1] 3 # ox-l, dx-3*1^2-3 
2, ] 12 # x-2, dx-3*2^2-12 

R 语 言 程序 计算 的 结果 ， 与 我 们 手动 计算 的 结果 是 一 致 的 。 但 计算 过 程 其 实 是 有 很 大 区 别 的 ， 我 们 手动 计算 时 是 通过 给 定 的 导数 计算 公式 ， 变 形 后 完成 计算 。 而 用 计算 机 程序 计算 时 ， 是 使 用 梯度 下 降 


法 来 计算 一 阶 导数 ， 是 一 种 最 优化 的 近似 算法 。 对 于 手动 计算 导数 时 ， 如 果 函 数 比较 复杂 而 且 比 较 难 应 用 可 变形 的 公式 ， 那 么 手动 计算 就 会 有 非常 大 的 困难 ， 而 计算 机 程序 的 方法 是 一 般 的 导数 计算 方法 ， 
不 会 受到 公式 难于 变形 的 影响 。 


我 们 使 用 deriv (expr, name) 函数 时 通常 要 传 2 个 参数 ， 第 一 参数 expr 就 是 原 函 数 公 式 ， 用 ~ 号 来 分 隔 公 式 的 两 边 ， 第 二 参数 name 用 于 指定 函数 的 自 变量 。deriv () 函数 会 返回 一 个 表达 式 


expression 类 型 变量 ， 再 | 


用 eval () 函数 运行 这 个 表达 式 就 可 得 到 计算 结果 ， 如 上 面 的 代码 实现 。 


如 果 希 望 以 函数 的 形式 调用 计算 公式 ， 那 么 你 还 需要 传 第 三 个 参数 func， 并 让 func 参 数 为 TRUE， 参 考 下 面 的 代码 实现 。 


计算 正弦 函数 y=sin 


(x) 的 导数 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 y=cos (x) ， 当 x=T 时 ，y=-1， 当 x=4r 时 ，y'=1。 


> dx «- deriv (y ~ 
function (x) 


func- TRUE) ; dx E 生成 导数 公式 的 调用 函数 


sin (x) "x" 


.value «- sin (x) 


.grad «- array m c (length (.value) , 1L), list (NULL, c ("x") ) ) 
-grad[, "x"] s= s (x) 
attr (.value, "gri vadient" ) «- .grad 
.value 
} 
> mode (dx) # 检查 dx 的 类 型 


[1] "function" 


» dx (c (pi, 4*pi) ) 


pa 
[1] 1i 224606e- 16 


attr G "gradient" 
I, 1 ^ 
[2,] 1 


E 以 参数 作为 自 变 量 ， 进 行 函数 调用 
-4.898425e-16 
* 导 函 数 的 计算 结果 
4 x-pi, dx-cos (pi) =- 
# x-4*pi, dx-cos (4* " =1 


1.5.2 ”初等 函数 的 导数 公式 


对 基本 的 初等 函数 求 导 数 ， 通 过 导数 计算 公式 是 可 以 直接 手动 完成 计算 的 。 下 面 为 一 元 初等 函数 的 导数 计算 公式 ， 其 中 y 是 原 函 数 ，x 是 y 函 数 的 自 变 量 ，y 是 y 函 数 的 导 函 数 。C，n，a 为 常数 ，In 表 示 以 


自然 常数 e 为 底 的 对 数 。 


第 数 函 数 


T É 2X 
CE: 8E: 


对 数 函 数 


正弦 函数 
余弦 函数 


原 函 数 导 函 数 
y=C y^0 


让 eu" 
y-"a* y'a lna 
y"e y^"e 


y'=1/(xln(a)) (a>0, E. a!=1,x>0) 
y-l/x 
ycos(x) 


y-log;x 
y-In(x) 
yesin(x) 


y-cos(x) y'—-sin(x) 


正切 函数 
余 切 函数 
正 割 函数 
余 割 函数 


y-tan(x) 
y-cot(x) 
y=sec(x) 
y=csc(x) 


y'7sec'(x)-l/cos (x) 
y —-csc'(x)- l/sin(x) 
y ^sec(x)*tan(x) 
y'—-esc(x)*cot(x) 


KER 函数 
反 余 弦 函 数 
REW 函数 
反 余 切 函数 


反正 割 函数 


vl E 


y=-1/ (fic) 
y=1/(1+x ) 
y'--1/(02x) 


y-arcsin(x) 
y-arccos(x) 
y-arctan(x) 


y-arccot(x) 


y-arcsec(x) pU E 


反 余 割 函 数 


y-arcesc(x) 


ETE, RIDENS TERTA. RARR, XENyERERBSEISRES, ELEUS— T EISERI. 


1. 常 数 函数 


计算 函数 y=3+10x 的 导数 ， 根 据 导数 计算 公式 ， 上 


手动 计算 的 变形 结果 为 y=0+10x， 常 数 项 3 的 导数 为 0， 当 x=1 时 ，y'=10。 


> dx«-deriv (y- 3410*x, "x", func = TRUE) # 以 函数 形式 生成 导数 公式 
> dx (1) # 传 入 自 变 量 ， 并 计算 
[1] 13 3 原 函 数 计算 结 en -13 
attr (, "gradient") 
x 
[1, ] 10 + 寻 函 数 计算 结果 Y'"=10*1=10 
2 BR 


于 手动 计算 的 变形 结果 为 y=4x3， 当 x=2 时 ，y'=32。 


计算 y=x4 函 数 的 导数 ， 根 据 导数 计算 公式 ， 


> dx«-deriv (y-x^4, "x", func = TRUE) 
» dx (2) 
[1] 16 


attr (, "gradient") 
x 


[1, ] 32 


# 导 浮 数 计算 结果 y'=4*x^3=4*2^3=32 


3. 指 数 函 数 


计算 y=4x 函 数 的 导数 ， 根 据 导 数 计算 公式 ， 


于 手动 计算 的 变形 结果 为 =4xIn (4) ， 当 x=2 时 ，y=22.18071。 


0» dx«-deriv (y-4^x , "x", func = TRUE) 
> dx (2) 
[1] 16 

attr (, "gradient") 


x 
[1, ] 22.18071 


+ 导 函 数 计算 结果 y'"=4^xx1og (4) 24*2^3-22.18071 


于 手动 计算 的 变形 结果 为 =ex， 当 x=2 时 ，y'=y=7.389056。 


计算 y=e* 函 数 的 导数 ， 根 据 导数 计算 公式 ， 


> dx«-deriv (y~exp (1) ^x 


x", func = TRUE) 


> dx (2) 

[1] 7.389056 

attr (, "gradient") 

[1.1 7.389036 + 时 函数 计算 结果 y'=exp (1) ^x-exp (1) ^2-7.389056 

计算 y=In (x) 函数 的 导数 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 y=1/x， 当 x=2 时 ,，y'=0.5。 


> dx«-deriv (y~log (x) , "x", func = TRUE) 


> dx (2) 


[1] 0.6931472 
attr (, "gradient") 
x 
[1, ] 0.5 + 导 蚁 数 计 算 结果 y'=1/x=1/2=0.5 


计算 y=log2x 函 数 的 导数 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 y=1/xlIna， 当 x=3 时 ，y'=0.4808983。 但 | 


R 语 言 编程 时 ， 只 能 计算 以 自然 常数 为 底 的 对 数 的 导数 ， 对 于 原 函 数 不 是 以 自然 


常数 为 底 的 对 数 ， 首 先 要 变换 成 以 自然 常数 为 底 的 对 数 再 进行 导数 计算 ， 根 据 对 数 的 换 底 公式 ， 把 以 2 为 底 的 对 数 转换 为 以 自然 常数 为 底 的 对 数 y=logzx=Inx/In2， 


> dx«-deriv (y-log (x) /log (2) , 
> dx (3) 

[1] 1.584963 

attr (, "gradient") 


x 
[1, ] 0.4808983 


"x", func = TRUE) 


# 导 函 数 计算 结果 y'=1/ (x*log (2) =1/ (3*1og (2) -0.4808983 


5. 正 弦 函 数 


计算 y=sin (x) 


函数 的 导数 ， 根 据 导数 计算 公式 ， 用 


于 手动 计算 的 变形 结果 为 y=cos (x) , 


当 x=T 时 ， y'=- 


> dx<-deriv (y~sin (x) , "x", func = TRUE) 
> dx (pi 
[1] 1.224606e-16 


attr (, "gradient") 


ee —E 


+ 导 函 数 计算 结果 Yy!=cos (x) =cos (pi) =- 


6 .余弦 函 数 


计算 y=cos (x) 函数 的 导数 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 y'=-sin (x) ， 当 x=TV2 时 ，yY'=- 


> dx«-deriv (y~cos (x) , "x", func = TRUE) 

> dx (pi/2) 

[1] 6. E 53032617 

attr (, "gradient") 
x 

[1, ] ~1 


# 导 函 数 计 算 结果 Y"=-sin (x) =-sin (pi/2) =- 


7. 正 切 函 数 


计算 y=tan (x) 函数 的 导数 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 y=sec2 (x) -1/cos? (x) ， 当 x=TV/6 时 ，Y=1.333333。 


> dx«-deriv (y-tan (x) , "x", func = TRUE) 
» dx (pi/6) 

[1] 0.5773503 

attr (, "gradient") 


x 
[1, ] 1.333333 


# 导 函 数 计算 结果 y'=1/cos (x) ^2-1/cos (pi/6) ^2-1.333333 


8. 余 切 函 数 


计算 y=cot (x) 函数 的 导数 ， 由 于 R 语 言 没有 cot () 函数 ， 所 以 根据 三 角 公 式 我 们 手动 变形 原 函 数 为 y=cot (x) =1/tan (x) 后 再 进行 导数 计算 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 y =- 


csc? (x) =-1/sin2 (x) ， 当 x=TV/6 时 ，yY=-4。 


> dx«-deriv (y~l/tan (x) , "x", func = TRUE) 
> dx (pi/6) 
[1] 1.732051 
attr (, "gradient") 
x 
[1, ] -4 dOSBAGEIEZ X y'--1/sin (x) ^2--1/sin (pi/6) ^2--4 


9. 反 正弦 函数 


计算 y=arcsin (x) 函数 的 导数 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 "VYi-*， 当 x=n/6 时 ,，y'=1.173757。 


> dx«-deriv (y~asin (x) , "x", func = TRUE) 
> dx (pi/6) 

[1] 0.5510696 

attr (, "gradient") 


x 
[1, ] 1.173757 + 导 函 数 计算 结果 y'=1/sqrt (1-x^2) =1/sqrt (1- (pi/6) ^2) -1.173757 


10. 反 余弦 函数 


计算 y=arccos (x) 函数 的 导数 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 y=-LYi-*， 当 x=n/8 时 ,，y'=-1.08735。 


> dx«-deriv (y~acos (x) , "x", func = TRUE) 
> dx (pi/8) 

[1] 1.167232 

attr (, "gradient") 


x 
[1, ] -1.08735 + 导 函 数 计算 结果 Y!=-1/sqrt (1-x^2) --1/sqrt (1- (pi/8) ^2) --1.08735 


11. 反 正切 函数 


计算 y=arctan (x) 函数 的 导数 ， 根 据 导数 计算 公式 ， 用 于 手动 计算 的 变形 结果 为 y=1/ (1+x2) , Mixem/6Rj, y'-0.7848335, 


> dx<-deriv (y~atan (x) , "x", func = TRUE) 
> dx (pi/6) 

[1] 0.4823479 

attr (, "gradient") 


x 
[1, ] 0.7848335 # 导 函 数 计算 结果 Y'= 1/ (19x^2) = 1/ (1+ (pi/6) ^2) -0.7848335 


1.5.3 ”二 阶 导数 计算 
当 我 们 对 一 个 函数 进行 多 次 连续 求 导 计算 ,就 会 形成 高 阶 导数 。 一 般 地 ， 函 数 y=f (x) 的 导数 y'=f'(x) 仍然 是 x 的 函数 ， 我 们 就 把 y'=f'(x) 的 导数 叫做 函数 y=f (x) 的 二 阶 导数 ， 记 作 y"， 即 


y SUY X acad ( 1.34) 


一 阶 导 数 的 导数 叫做 二 阶 导 数 ， 二 阶 导 数 的 导数 叫做 三 阶 导数 ，N-1 阶 导数 的 导数 叫做 N 阶 导数 ， 习 惯 上 把 二 阶 以 上 的 导数 称 之 为 高 阶 导数 。 


下 面 计算 函数 y=sin (ax) 的 二 阶 导数 y"， 其 中 a 为 常数 。 根 据 导数 计算 公式 ， 用 手动 计算 的 变形 结果 ， 一 阶 导数 为 y'=acos (ax) ， 对 y 再 求 导 公式 变形 为 ，y'=-a2sin (ax) 


R 语 言 进行 程序 实现 


> a<-2 + 设置 a 的 值 


> dx<-deriv (y~sin (a*x) , "x", func = TRUE) # 生成 一 阶 导 数 公式 
> dx (pi/3) + 计算 一 阶 导数 
1] 0.8660254 
attr (, "gradient") 
x 
1, ] -1 + BAH y'= a*cos (a*x) =2*cos (2*pi/3) =-1 
> dx«-deriv (y~a*cos (a*x) , "x", func = TRUE) # 对 一 阶 导 函 数 求 导 
> dx (pi/3) 
1] =1 


attr (, "gradient") 


x 
1, ] -3.464102 + 导 函 数 计算 结果 Yy'= -a^2*sin (a*x) --2^2*sin (2*pi/3) —-3.464102 


上 面 二 阶 导 数 的 计算 ， 我 们 是 手动 划分 为 两 次 求 导 进行 计算 的 ， 利 用 deriv3 () 函数 其 实 合并 成 一 步 计 算 。 


> dx«-deriv3 (y~sin (a*x) , "x", func = TRUE) # 生成 二 阶 导数 公式 


> dx (pi/3) # 计算 导数 
[1] 0.8660254 
attr (, "gradient") 
x 
[1, ] -1 # 一 阶 导 数 结果 
attr (, "hessian") , , x 
x 
[1，] -3.464102 # 二 阶 导 数 结果 


我 们 再 计算 另外 一 个 二 阶 导数 ， 计 算 y=ax4+bx3+x2+X+c， 其 中 a，b，c 为 常数 ，a=2，b=1，c=3， 根 据 导数 计算 公式 ， 手 动 计算 的 变形 结果 ， 一 阶 导数 为 


y'= (2x4+x3+x2+x+3') =8x3+3x2+2x+1， 当 x=2 时 ，y'=81， 对 y' 再 求 导 公式 变形 为 ，y"=24x2+6x+2， 当 x=2 时 ,，y"=110。 


> dx«-deriv3 (y~a*x^4+b*x^3+x^2+x+c, "x", func-function (x, a=2, b=1, c-3) (D 
* 通过 func 和 参数， 指定 常数 值 
> dx (2) 
[1] 49 
attr (, "gradient") 
x 
[1, ] 81 # 一 阶 导 数 结果 
attr (, "hessian") , , x 
x 


[1, ] 110 # 二 阶 导 数 结果 


这 样 就 直接 完成 了 二 阶 导数 的 计算 ,在 R 语 言 中 二 阶 导数 是 可 以 直接 求 出 的 ， 想 计算 更 高 阶 的 导数 就 需要 其 他 的 数学 工具 包 了 。 


1.54 RSSA 


在 一 元 函数 中 ,我们 已 经 知道 导数 就 是 函数 的 变化 率 。 对 于 二 元 函数 我 们 同样 要 研究 它 的 “变化 率 ”。 然 而 ， 由 于 自 变量 多 了 一 个 ， 情 况 就 要 复杂 得 多 。 在 数学 中 ， 一 个 多 变量 的 函数 的 偏 导 数 ， 就 是 
它 关 于 其 中 一 个 变量 的 导数 而 保持 其 他 变量 恒定 (相对 于 全 导数 ， 在 其 中 所 有 变量 都 允许 变化 ) 。 偏 导数 的 算 子 符号 为 6。 记 作 Gf/6x 或 者 fx。 偏 导数 反映 的 是 函数 沿 坐标 轴 正 方向 的 变化 率 ， 在 向 量 分 析 和 
微分 几何 中 是 很 有 用 的 。 


在 xOy 平 面 内 ， 当 动 点 由 P (xo, yo) 沿 不 同方 向 变化 时 ， 函 数 f (x, y) 的 变化 快慢 一 般 来 说 是 不 同 的 ， 因 此 就 需要 研究 f (x, y) 在 点 (Xo. yo) 处 沿 不 同方 向 的 变化 率 。 在 这 里 我 们 只 学 习 函 数 
f (x, y) 在 xOy 平 面 沿 着 平行 于 x 轴 和 平行 于 y 轴 两 个 特殊 方位 变动 时 ，f (x, y) 的 变化 率 。 


> 方向 的 偏 导数 : 设 有 二 元 函数 z=f (x, y), A (Xo, yo) 是 其 定义 域 D 内 一 点 。 把 y 固 定 在 yo 而 让 x 在 xo0 有 增 量 Ax， 相 应 地 函数 z=f (x, y) 有 增 量 ( 称 为 对 x 的 偏 增 量 ) Az=f (xo+Ax，yo) - 
f (xo, yo) 。 如 果 Az 与 Ax 之 比 当 Ax 一 0 时 的 极限 存在 ， 那 么 此 极限 值 称 为 函数 z=f (x, y) Œ (xo, yo) 处 对 x 的 偏 导 数 (partial derivative) 。 记 作 fx (xo, yo) . 


y 方 向 的 偏 导数 : 函数 z=f (x, y) Œ (xo, yo) 处 对 x 的 偏 导数 ， 实 际 上 就 是 把 y 固 定 在 yo (看 成 常数 ) 后 ， 一 元 函数 z=f (x, yo) 在 x0 处 的 导数 。 同 样 ， 把 x 固 定 在 xo0， 让 y 有 增 量 Ay， 如 果 极 限 存 在 那 
么 此 极限 称 为 函数 z= (x, y) 在 (xo, yo) 处 对 y 的 偏 导 数 。 记 作 fy (xo, yo) 。 


同样 ， 我 们 可 以 通过 R 语 言 的 deriv () 函数 进行 偏 导数 的 计算 。 下 面 我 们 计算 一 个 二 元 函数 f Ou y) =2x2+y+3xy2 的 偏 导数 ， 由 于 二 元 函数 曲面 上 每 一 点 都 有 无 穷 多 条 切线 ， 描 述 这 个 函数 的 导数 就 
会 相当 困难 。 如 果 让 其 中 的 一 个 变量 y 取 值 为 常数 ， 那 么 就 可 以 求 出 关于 另 一 个 自 变量 x 的 偏 导 数 了 ， 即 QH Gx。 


下 面 我 们 分 别 对 x，y 两 个 自 变量 求 偏 导数 ， 设 变量 y 为 常数 ， 计 算 x 的 偏 导数 QH/Gx=4x+ 3y2， 当 x=1，y=1 时 ，x 的 偏 导数 /ax=4x+ 3y2=7。 设 变量 x 为 常数 ， 计 算 y 的 偏 导 数 SWay=1+6xy， 当 
x=1，y=1 时 ，y 的 偏 导 数 GH/Gx=1+6xy=7。R 语 言 程序 实现 如 下 。 


> fxy = expression (2*x^2*yt3*x*y^2) # 二 元 函数 公式 
> dxy = deriv (fxy, c ("x", "y") , func = TRUE) 
> dxy 


function (x, y) 
{ 
.expr4 «- 3 * x 


.expr5 «- y^2 
.value «- 2 * x^2 * y * .expr4 * .expr5 
.grad <- array (0, c (length (.value) , 21) , list (NULL, c ("x", "y") ) ) 


.grad[, "x"] <- 2 * (2 * x) + 3 * .expr5 
.grad[, "y"] <- 1 + .expr4 * (2 * y) 


attr (.value, "gradient") <- .grad 
.Value 
> dxy (1, 1) # 设置 自 变量 
[1] 6 
attr (, "gradient") 
xy # 计算 结果 ，x 的 偏 导 数 为 7，y 的 偏 导数 为 7 
[ig EE e 


偏 导 数 的 程序 计算 结果 与 手动 计算 结果 是 一 致 的 。 


下 面 我 们 再 求 一 个 复杂 函数 的 偏 导数 ， 计 算 一 个 二 元 函数 f (x，y) =Xy+exy+xe-2xy+y3+sin (xy) 在 点 (1, 3) 和 点 (0, 0) 的 偏 导数 。R 语 言 程序 实现 如 下 。 
> fxy = expression (x^y + exp (x * y) + x^2- 2 * x * y+ y^3 + sin (x*y) ) 
> dxy = deriv (fxy, c ("x", "y"), func = TRUE) 
> dxy (1, 3) # 设置 自 变量 
[1] 43.22666 
attr (, "gradient") 
x y 
[1, ] 56.28663 44.09554 + 计算 结果 ，x 的 偏 导 数 为 56.28663，Yy 的 偏 导数 为 44.09554 
> dxy (0, 0) 
[1] 2 
attr (, "gradient") 


x y 
[1, ] NaN -Inf # 计算 结果 ，x 的 偏 导 数 无 意义 ，y 的 偏 导数 负 无 穷 大 


对 于 计算 结果 有 异议 的 同学 ， 可 以 尝试 手动 计算 。 


本 节 我 们 学 习 了 用 R 语 言 做 高 等 数学 的 导数 计算 ， 真 的 是 非常 方便 ， 这 下 更 有 动力 学 习 高 数 了 。 


第 2 章 R 语 言 的 算法 实现 


本 章 用 R 语 言 实现 了 4 个 算法 案例 ， 包 括 协 同 过 滤 算法 、PageRank 算 法 、 均 线 模型 算法 和 遗传 算法 ， 希 望 这 些 案例 可 以 帮助 读者 理解 R 语 言 在 实际 业务 中 的 应 用 。 


2.1 用 R 重 写 Mahout 协 同 过 滤 算法 
问题 


如 何 用 R 语 言 实现 推荐 算法 ? 


24.1 


RHRESMahout? mitis 


http://blog.fens.me/r-mahout-usercf/ 


Mahout 的 推荐 算法 模型 


推荐 系统 在 互联 网 应 用 中 很 常见 ， 比 如 亚马逊 为 你 推荐 购书 列表 ， 豆 
法 。 本 节 将 用 R 语 言 来 重 写 推荐 部 分 的 基于 用 户 的 协同 过 滤 算 法 。 用 R 语 言 重 写 Mahout 的 基于 用 户 的 协同 过 滤 推 荐 算法 ， 将 完全 按照 Mahout 的 思路 和 设计 进行 实现 ， 并 与 Mahout 的 计算 结果 进行 对 比 。 


首先 我 们 需要 了 解 一 下 ， 协 同 过 滤 算 法 在 Mahout 中 是 如 何 实现 的 。 Mahout 的 推荐 算法 定义 了 一 套 标准 化 的 模型 构建 过 程 和 调用 


分 类 算 


豆 关 为 你 推荐 电影 列表 。Mahout 是 Hahoop 家 族 用 于 机 器 学 习 的 分 步 式 计算 框架 ， 主 要 包括 三 类 算法 ， 即 推荐 算法 、 聚 类 算法 和 分 


户 的 协同 过 滤 算法 (UserCF) 为 例 ， 如 图 2-1 所 示 。 


过 程 ， 以 基于 用 


2 


用 户 相 似 度 算法 


srs > or milane | TM — 
上 RE Y 


从 图 2-1 中 我 们 可 以 看 到 ， 基 于 


定义 用 户 近邻 算法 (UserNeighborhood) 


， 最 后 调 


本 节 中 将 用 R 语 言 


户 的 协同 过 滤 算 法 是 被 模块 化 的 ， 通 过 4 个 模块 进行 统一 的 方法 调用 
过 程 。 而 基于 


用 


2-1 Mahout 推 荐 算法 模型 (摘自 《Mahout In Action» ) 
。 首 先 ， 创 建 数据 模型 (DataModel) ， 然 后 定义 用 户 的 相似 度 算法 (UserSimilarity) ， 接 下 来 
FF 物品 的 协同 过 滤 算 法 (ItmCF) 过 程 也 是 类 似 的 ， 去 掉 第 三 步 计算 用 户 的 近邻 算法 就 行 了 。 


推荐 算法 (Recommender) 完成 计算 过 程 


对 Mahout 的 0.5 版 本 算法 进行 重新 实现 ， 下 面 是 Mahout 在 Maven 中 版 本 定义 


<dependency> 
<groupId>org.apache.mahout</groupId> 


«artifactlId»mahout-core«/artifactld» 
«version»0.5«/version» 
</dependency> 


我 们 选用 一 组 比较 简单 的 测试 数据 集 testCF.csv， 数 据 集 分 为 3 列 : 用 户 ID、 物 品 ID 以 及 用 户 对 物品 的 打分 。 一 共 21 行 数据 。 


106, 
301, 
102, 
103, 
104, 
105, 
106, 


1, 101, 5.0 
1, 102, 3.0 
1, 103, 2.5 
2, 101, 2.0 
2, 102, 2.5 
2, 103, 5.0 
2, 104, 2.0 
3, 101, 2.5 
3, 104, 4.0 
3, 105, 4.5 
3, 107, 5.0 
4, 101, 5.0 
4, 103, 3.0 
4, 104, 4.5 
4, 4.0 
5, 4.0 
5, 3.0 
5, 2.0 
5, 4.0 
5, 3.5 
5, 4.0 


我 们 先 看 一 下 如 何 用 Java 语 言 使 用 Mahout 库 的 AP1， 实 现 基于 用 户 的 协同 过 滤 算 法 的 代码 。Java 程 序 实现 代码 如 下 所 示 。 


Ln 
* UserCF 测 试 ， 单 机 算法 实现 程序 
*/ 
public class UserCF ( 
final static int NEIGHBORHOOD NUM - 2; // 取 2 个 近邻 
final static int RECOMMENDER NUM = 3; // 保留 3 个 推荐 结果 


public static void main (String[] args) throws IOException， TasteException { 


String file - "item.csv"; // 读 入 数据 集 
DataModel model = new FileDataModel (new File (file) ) ; // 加 载 数 据 到 内 存 对 象 DataModel 
UserSimilarity user = new EuclideanDistanceSimilarity (model) ; 
// 定义 用 户 相 似 度 距离 
NearestNUserNeighborhood neighbor = new NearestNUserNeighborhood 
(NEIGHBORHOOD NUM, user, model) ; // 定义 近邻 
Recommender r = new GenericUserBasedRecommender (model, neighbor, user) ; 
// 创建 推荐 模型 
LongPrimitiveIterator iter = model.getUserIDs () ; // 取得 用 户 列 表 
while (iter.hasNext () ) ( // 循环 用 户 列表 ， 计 算 给 每 个 用 户 的 推荐 结果 
long uid = iter.nextLong () ; 
List list = r.recommend (uid, RECOMMENDER NUM) ; 
System.out.printf ("uid: $s", uid) ; T 
for (RecommendedItem ritem : list) { 
System.out.printf (" ($s, $f) ", ritem.getItemID () , ritem.getValue () ) ; 
// 打印 推荐 结果 
} 
System.out.println () ; 


运行 Java 程 序 ， 输 出 推荐 结果 。 


uid: 
uid: 
uid: 
uid: 
uid: 


1 (104, 4.250000) (106, 4.000000) 
2 (105, 3.956999) 

3 (103, 3.185407) (102, 2.802432) 
4 (102, 3.000000) 

5 


对 结果 的 解读 如 下 。 


“ 给 uid=1 的 用 户 ， 推 荐 计算 得 分 最 高 的 2 个 物品 ，104 和 106。 


: 给 uid=2 的 用 户 ， 推 荐 计算 得 分 最 高 的 1 个 物品 ，105。 


“ 给 uid=3 的 用 户 ， 推 荐 计算 得 分 最 高 的 2 个 物品 ，103 和 102。 


“ 给 uid=4 的 用 户 ， 推 荐 计算 得 分 最 高 的 1 个 物品 ，102。 


“ 给 uid=5 的 用 户 ， 没 有 推荐 。 


21.2 ”R 语 言 模型 实现 


接 下 来 ， 我 们 使 用 R 语 言 重 写 Mahout 的 实现 ，R 语 言 代 码 将 完全 按照 Mahout 源 代码 的 程序 设计 思路 进行 实现 。 为 保证 与 java 程序 思路 一 致 ，R 代 码 用 


(1 


(2) 


(3 


(5 


RE 


言 构建 算法 模型 ， 将 按照 下 面 的 5 个 步骤 进行 : 


回 


建立 数据 模型 


欧 氏 距离 相似 度 算法 


近邻 算法 


推荐 算法 


1. 建 立 数据 模型 


创建 数据 模型 的 函数 FileDataModel () ， 主 要 用 于 从 CSV 文 件 中 读 取 数 据 ， 然 后 以 R 语 言 中 和 矩阵 类 型 (matrix) 加 载 到 内 存 中 。 


了 for 循 环 实现 ， 这 里 暂时 不 考虑 R 程 序 的 性 能 。 


FileDataModel«-function (file) ( # 数据 模型 函数 
data«-read.csv (file, header-FALSE) # 读 CSV 文 件 到 内 存 
names (data) «-c ("uid", "iid", "pref") + 增加 列 名 
user «- unique (data$uid) + 计算 用 户 数 
item <- unique (sort (data$iid) ) # 计算 产品 数 


uidx «- match (data$uid, user) 
iidx <- match (data$iid, item) 


M «- matrix (0, length (user) , length (item) ) # 定义 存储 和 矩阵 
i <- cbind (uidx, iidx, pref-data$pref) 
for (n in 1: nrow (i) ) { # 给 矩阵 赋值 
M[i[n, ][1], ifn, 1([21]«-i[n, 113] 
} 


dimnames (M) [[2]]«-item 

M * 返回 矩阵 数据 
} 
2. 欧 氏 距离 相似 度 算法 


我 们 在 计算 用 户 相似 度 算法 的 时 候 可 以 有 多 种 选择 ， 如 欧 氏 距离 相似 度 算法 、 皮 尔 森 相似 度 算法 、 余 弦 相 似 度 算法 、Spearman 秩 相关 系数 相似 度 算法 、 曼 哈 顿 距离 相似 度 算法 、 对 数 似 然 相似 度 算法 
等 ， 很 多 算法 都 有 对 应 的 R 语 言 函 数 ， 直 接 调用 就 可 以 了 。 按 照 Mahout 的 代码 实现 思路 ， 它 对 于 基础 的 算法 做 了 一 些 优化 ， 因 此 我 们 也 需要 完全 从 底层 重 写 这 些 算法 。 


下 面 将 以 欧 氏 距离 相似 度 算法 为 例 ， 创 建 欧 氏 距离 相似 度 的 计算 函数 Euclidean-DistanceSimilarity () ， 加 载 用 户 物品 的 矩阵 数据 ， 通 过 欧 氏 距离 来 计算 用 户 的 相似 度 。 


EuclideanDistanceSimilarity«-function (M) { 

row«-nrow (M) 

s«-matrix (0, row, row) # 相似 度 矩 阵 

for (zl in 1: row) { 

for (z2 in 1: row) ( 
if (z1«z2) ( 
num«-intersect (which (M[zl, ]! -0) , which (M[z2, ]! =0) ) o 可 计算 的 列 
sum<-0 
for (z3 in num) ( 
sum«-sum* (M[zl, ][z3]-M[z2, ][z3]) ^2 


} 
s[z2, z1]<-length (num) / (1*sqrt (sum) ) 
if (s[z2, z1]»1) s[z2, z1]«-1 # 对 算法 的 阅 值 进行 限制 
if (s[z2, z1]«-1) s[z2, zl]«- -1 
} 
j 
} 
ts<-t (s) + odRAOÍAEM- 
w<-which (upper.tri (ts) ) 
s[w]<-ts[w] 
s # 返回 用 户 相似 度 和 矩阵 
} 


3. 用 户 近邻 算法 


我 们 在 计算 用 户 近邻 的 时 候 ， 也 有 2 种 算法 来 选择 。 一 种 是 以 个 数 来 计算 的 ， 选 出 最 近 的 前 几 个 ; 另 一 种 是 以 百分比 来 计算 的 ， 选 出 最 近 的 前 百 分 之 几 的 数量 。 下 面 将 以 个 数 计算 为 例 ， 选 出 最 近 的 前 N 
个 用 户 。 创 建 最 近邻 计算 的 函数 NearestNUserNeighborhood () ， 传 入 用 户 的 相似 度 和 矩阵 和 个 数 ， 就 能 计算 出 用 户 最 近邻 了 。 


NearestNUserNeighborhood«-function (S, n) ( 
row«-nrow (S) 
neighbor«-matrix (0, row, n) 
for (zl in 1: row) { 
for (z2 in 1: n) ( 
me-which.max (S[, z1]) 
neighbor[z1l, ][z2]«-m 
S[, z1] [m]-0 
} 
l 
neighbor # 返回 前 n 个 最 近邻 


4 推荐 算法 


我 们 在 计算 推荐 的 时 候 ， 也 有 几 种 算法 可 以 选择 ， 如 基于 用 户 的 推荐 算法 、 基 于 物品 的 推荐 算法 、slopeOne 推 荐 算法 、itemKNN 推 荐 算法 、SVD 推 荐 算法 、TreeCluster 推 荐 算法 ， 这 几 种 推荐 算法 要 
与 上 面 定义 的 数据 和 相似 度 算法 进行 匹配 才能 一 起 使 用 。 


下 面 我 们 创建 基于 用 户 的 推荐 算法 计算 的 函数 UserBasedRecommender () ， 通 过 用 户 物 品 数据 矩阵 、 用 户 相似 度 和 矩阵 、 用 户 最 近邻 ， 按 基于 用 户 的 协同 过 滤 算法 实现 ， 计 算出 推荐 结果 。 


UserBasedRecommender«-function (uid, n, M, S, N) ( 
row«-ncol (N) 
col«-ncol (M) 
r«-matrix (0, row, col) 
Ni«-N[uid, ] 
for (zl in 1: length (N1) ) ( 
num«-intersect (which (M[uid, ]--0) , which (M[N1[z1], ]! =0) ) # 可 计算 的 列 
for (z2 in num) ( 
r[zl, z2]-M[N1[z1], z2]*S[uid, N1[z1]] 
} 


l 
# print (r) V 打印 每 个 用 户 的 推荐 矩阵 
sum<-colSums (r) 
s2<-matrix (0, 2, col) 
for (zl in 1: length (N1) ) { 
num«-intersect (which (colSums (r) ! =0) , which (M[N1[z1], ]! =0) ) 
for (z2 in num) { 
s2[1, ][z2]«-s2[1, ][z2]*S[uid, N1[z1]] 
s2[2, 1[z2]«-s2[2, 1[z2]*1 
} 


} 
s2[, which (s2[2, ]==1) ]=10000 
s2«-s2[-2, ] 
r2«-matrix (0, n, 2) 
rr«-sum/s2 
item «-dimnames (M) [[2]] 
for (zl in 1: n) ( 
w«-which.max (rr) 
if (rr[w]20.5) ( 
r2[zl, 1]«-item[which.max (rr) ] 
r2[z1, 2]«-as.double (rr[w]) 
rr[w]-0 


这 样 基于 用 户 的 协同 过 滤 算 法 的 函数 ， 我 们 都 已 经 用 R 程 序 实现 了 。 下 面 按照 调用 关系 ， 我 们 运行 这 些 功能 函数 。 


5. 运 行程 序 

> FILEc-"item.csv" + 数据 文件 

> NEIGHBORHOOD NUM«-2 # 取 2 个 最 大 近邻 

> RECOMMENDER NUM«-3 # 保留 最 多 3 个 推荐 结果 

> M«-FileDataModel (FILE) + 把 数据 文件 ， 摘 成 矩阵 加 载 到 内 存 

> S«-EuclideanDistanceSimilarity (M) d H P dedi RAE M- 

» N«-NearestNUserNeighborhood (S, NEIGHBORHOOD NUM) 43 计算 用 户 近 邻 

> Ri«-UserBasedRecommender (1, RECOMMENDER NUM, M, S, N) ; R1 # 查看 对 User=1 的 推荐 结果 
L 1] [, 2] 

Îl, ] "104^ "4,25" 


E 


3, "Qn "Qn 


» R2«-UserBasedRecommender (2, RECOMMENDER NUM, M, S, N) ; R2 # 查看 对 User=2 的 推荐 结果 
¿L i2 

1, ] "105" "3.95699903407931" 

2 ] "O" "Q^ 

3 ] "o" "o" 

» R3«-UserBasedRecommender (3, RECOMMENDER NUM, M, S, N) ; R3 4 查看 对 User=3 的 推荐 结果 
,1] [2] 

1, ] "103" "3.18540697329411" 

p .80243217111765" 

3, " or 

> R4<-UserBasedRecommender (4, RECOMMENDER NUM, M, S, N) ; R4 # 查看 对 User=4 的 推荐 结果 
,1] L2 

1, ] "102" "3" 

2 ] "0" "o" 

$5] "O" "o" 

» R5«-UserBasedRecommender (5, RECOMMENDER NUM, M, S, N) ; R5 4 查看 对 User=5 的 推荐 结果 
sil L 2] 

Jy 0 

2, 0 0 

3 0 0 


最 后 我 们 看 到 计算 结果 ， 同 调用 Mahout 的 API 的 Java 程 序 的 计算 结果 是 一 致 的 。 


2.1.3 ”算法 实现 的 原理 一 一 和 矩阵 变换 


那么 我 们 算法 实现 的 原理 是 什么 呢 ? 所 谓 协同 过 滤 算法 ， 其 实 就 是 矩阵 变换 的 结果 ! 请 大 家 下 面 留意 每 一 步 的 矩阵 变换 。 从 原始 数据 文件 开始 ， 如 下 所 示 。 


1, 101, 5.0 
1, 102, 3.0 
1, 103, 2.5 
2, 101, 2.0 
2, 102, 2.5 
2, 103, 5.0 
2, 104, 2.0 
3, 101, 2.5 
3, 104, 4.0 
3, 105, 4.5 
3, 107, 5.0 
4, 101, 5.0 
4, 103, 3.0 
4, 104, 4.5 
4, 106, 4.0 
5, 101, 4.0 
5, 102, 3.0 
5, 103, 2.0 
5, 104, 4.0 
5, 105, 3.5 
5, 106, 4.0 


第 一 步 的 矩阵 变换 ， 通 过 FileDataModel () 函数 ， 输 出 用 户 物品 矩阵 。 


101 102 103 104 105 106 107 
[1, ] 5:0.3.0 2.5 0.0 0:0 0 O 
[2,] 2.0 2.5 5.0 2.00.0 0 0 
[3,] 2.5 00.00.04.04.5 0 5 
[4, ] 5.00.03.04.50.0 4 0 
[5,] 4.0 3.0 2.0 4.0 3.5 4 0 


第 二 步 ， 利 用 欧 氏 相似 度 算法 进行 矩阵 变换 ， 运 行 EuclideanDistanceSsimilarity () 函数 ， 结 果 如 下 所 示 。 


L, 1] [, 2] L 3] [, 4] [, 5] 
[1, ] 0.0000000 0.6076560 0.2857143 1.0000000 1.0000000 
[2, ] 0.6076560 0.0000000 0.6532633 0.5568464 0.7761999 
[3, ] 0.2857143 0.6532633 0.0000000 0.5634581 1.0000000 
[4, ] 1.0000000 0.5568464 0.5634581 0.0000000 1.0000000 
[5, ] 1.0000000 0.7761999 1.0000000 1.0000000 0.0000000 


第 三 步 ， 通 过 用 户 相 似 度 和 矩阵 ， 计 算出 用 户 最 近邻 ， 运 行 EuclideanDistanceSimilarity () 函数 ， 结 果 如 下 所 示 。 


topl top2 
4 5 


wwN 
FF on 
LN CO 


第 四 步 ， 把 上 面 的 矩阵 合并 计算 ， 通 过 基于 用 户 的 推荐 算法 ， 得 到 每 个 用 户 的 推荐 矩阵。 以 uid=1 的 用 户 为 例 ， 运 行 UserBasedRecommender () 函数 ， 结 果 如 下 所 示 。 


101 102 103 104 105 106 107 
4 0 0 0 4.5 .0 4 0 
5 0 0 0 4.0 3.5 4 0 


打开 注释 行 : UserBasedRecommender () 函数 的 代码 注释 print (r) 奎 J 印 每 个 用 户 的 推荐 矩阵 。 


第 五 步 ， 过 滤 推 荐 矩阵 的 结果 ， 取 前 2 个 得 分 最 高 的 推荐 结果 返回 。 以 uid= 1 的 用 户 为 例 ， 结 果 如 下 所 示 。 


推荐 物品 ”物品 得 分 
[1, ] "104" "4.25" 
[2; ] "106" D 


通过 这 5 步 和 矩阵 变换 ， 我 们 就 可 以 清楚 地 看 到 基于 用 户 的 协同 过 滤 算法 的 本 质 了 。 当 然 ，Mahout 所 提供 的 算法 。 都 是 以 矩阵 为 基础 的 可 以 处 理 海 量 数据 的 算法 。 如 果 我 们 的 数据 量 很 小 ， 可 以 把 上 面 的 
算法 过 程 优化 并 改进 ， 降 低 矩 阵 计算 的 复杂 度 。 


214 ”算法 总 结 


本 节 只 是 用 R 语 言 重 写 了 Mahout 的 基于 用 户 的 、 欧 氏 距 离 相 似 度 、 个 数 最 近邻 的 协同 过 滤 算法 ， 重 写 其 他 的 算法 过 程 也 是 类 似 的 。 另 外 ， 在 读 Mahout 源 代码 的 过 程 中 发 现 ，Mahout 做 各 种 算法 时 ， 
都 有 自己 的 优化 ， 并 不 是 简单 地 套用 教 课 书 上 的 算法 公式 。 比 如 ， 计 算 基 于 欧 氏 距离 的 用 户 相似 度 时 ， 并 不 是 标准 的 欧 氏 距离 算法 ， 而 是 改进 的 欧 氏 距离 算法 。 


similar 
similar 


1/ (1*sqrt ( (a-b) ^2 + (a-c) ^2) ) d 欧 氏 距离 算法 
n/ (1+sqrt ( (a-b) ^2 + (a-c) ^2 ) ) # 改进 的 欧 氏 距离 算法 


公式 解释 : 


“ a，b 是 被 两 个 用 户 都 打分 的 物品 ， 也 可 能 是 1 个 或 者 多 个 


“ n 是 被 两 个 用 户 都 打分 的 物品 的 个 数 


< 当 similar>1 时 ， 则 similar=1 


* 当 similar<-1 时 ， 则 similar=-1 


通过 算法 的 优化 ，Mahout 可 以 给 出 更 准确 的 推荐 结果 。 所 以 ， 想 用 Mahout 做 推荐 引擎 的 同学 ， 就 要 对 自己 要 求 高 一 点 ， 不 仅 要 会 Java， 会 Mahout， 还 要 知道 底层 算法 以 及 Mahout 对 算法 的 改动 ， 
这 样 Mahout 在 你 手中 才能 发 挥 出 真正 的 威力 ! 关于 Mahout 的 更 多 文章 ， 请 查阅 笔者 的 博客 (http://blog.fens.me/hadoop-mahout-roadmap/) 。 


2.2 ”PageRank 算 法 R 语 言 实现 


问题 


如 何 用 R 语 言 实现 PageRank 算 法 ? 


PageRank +R 


PageRank 算 法 R 语 言 实现 
http://blog.fens.me/algorithm-pagerank-r/ 


Google 搜 索 ， 早 已 成 为 我 每 天 必用 的 工具 ， 我 无 数 次 惊叹 它 搜索 结果 的 准确 性 。 同 时 ， 我 也 在 做 Google 的 SEO ， 推 广 自己 的 博客 。 经 过 几 个 月 尝试 ， 我 的 博客 PR 到 2 了 ， 外 链 也 有 几 万 个 。 总 结 下 来 ， 还 
是 感叹 PageRank 的 神奇 。 笔 者 认为 PageRank 是 改变 互联 网 的 算法 ! 


22.1 PageRank 算 法 介绍 


PageRank 是 Google 专 有 的 算法 ， 用 于 衡量 特定 网 页 相对 于 搜索 引擎 索引 中 的 其 他 网 页 而 言 的 重要 程度 。 它 由 Larry Page 和 Sergey Brin 在 20 世 纪 90 年 代 后 期 发 明 。PageRank 实 现 了 将 链接 价值 概念 作 
为 排名 因素 。 


PageRank 是 让 链接 来 “投票 ”。 一 个 页 面 的 “得 票数 ”由 所 有 链 向 它 的 页 面 的 重要 性 来 决定 ， 指 向 一 个 页 面 的 超 链接 相当 于 对 该 页 投 一 票 。 一 个 页 面 的 PageRank 是 由 所 有 链 向 它 的 页 面 ( 链 入 页 面 ) 
的 重要 性 经 过 递归 算法 得 到 的 。 一 个 有 较 多 链 入 的 页 面 会 有 较 高 的 等 级 ， 相 反 如 果 一 个 页 面 没有 任何 链 入 页 面 ， 那 么 它 没有 等 级 。 简 单一 句 话 概括 ， 就 是 从 许多 优质 的 网 页 链接 过 来 的 网 页 ， 必 定 还 是 优质 
网 页 。 


PageRank 的 计算 基于 以 下 两 个 基本 假设 ， 一 是 数量 假设 ， 即 如 果 一 个 页 面 节点 接收 到 的 其 他 网 页 指向 的 入 链 数量 越 多 ， 那 么 这 个 页 面 越 重 要 ; 二 是 质量 假设 ， 即 指向 页 面 A 的 入 链 质 量 不 同 ， 质 量 高 的 
页 面 会 通过 链接 向 其 他 页 面 传递 更 多 的 权重 ， 所 以 越 是 质量 高 的 页 面 指向 页 面 A， 页 面 A 越 重要 。 


要 提高 PageRank 有 3 个 要 点 ， 也 就 是 我 们 做 SEO 时 必须 要 考虑 的 问题 : 


(1) 反 向 链接 数 : 反 向 链接 数 越 多 ， 指 向 页 面 的 权重 越 高 。 


(2 


ra 


反 向 链接 是 否 来 自 PageRank 较 高 的 页 面 : 链接 页 面 的 权重 越 高 ， 指 向 页 面 分 配 的 权重 就 越 高 。 


Dis 
B 


(3) 反 向 链接 源 页 面 的 链接 数 : 反 向 链接 页 面 的 链接 数 越 多 ， 则 反 向 链接 源 页 面 的 权重 越 高 。 循 环 解释 前 面 两 条 。 


2.22 PageRank 算法 原理 


每 个 页 面 设置 相同 的 pageRank 值 ， 通 过 若干 轮 的 递归 计算 ， 会 得 到 每 个 页 面 所 获得 的 最 终 PageRank 值 。 随 着 每 一 轮 的 计算 进行 ， 网 页 当前 的 


在 初始 阶段 ， 网 页 通过 链接 关系 构建 起 有 向 
PageRank 值 会 不 断 得 到 更 新 。 


IR] 


在 一 轮 更 新 页 面 PageRank 得 分 的 计算 中 ， 每 个 页 面 将 其 当前 的 PageRank 值 平均 分 配 到 本 页 面 所 包含 的 出 链 上 ， 这 样 每 个 链接 即 获得 了 相应 的 权 值 。 而 每 个 页 面 将 所 有 指向 本 页 面 的 入 链 所 传 入 的 权 值 
求 和 ， 即 可 得 到 新 的 PageRank 得 分 。 当 每 个 页 面 都 获得 了 更 新 后 的 PageRank 值 ， 就 完成 了 一 轮 PageRank 计 算 。 


1. 算 法 原理 


PageRank 算 法 建立 在 随机 冲浪 者 模型 上 ， 其 基本 思想 是 : 网 页 的 重要 性 排序 是 由 网 页 间 的 链接 关系 所 决定 的 ， 算 法 是 依靠 网 页 间 的 链接 结构 来 评价 每 个 页 面 的 等 级 和 重要 性 ， 一 个 网 页 的 PR 值 涉及 指 
向 它 的 链接 网 页 数 ， 还 涉及 指向 它 的 网 页 的 其 他 网 页 本 身 的 重要 性 。 


PageRank 具 有 两 大 特性 ， 一 是 PR 值 的 传递 性 ， 即 网 页 A 指 向 网 页 B 时 ， 网 页 A 的 PR 值 会 部 分 传递 给 网 页 B; 二 是 重要 性 的 传递 性 ， 即 一 个 重要 的 网 页 比 一 个 不 重要 网 页 ， 传 递 的 权重 要 更 多 。 


2. 计 算 公式 


PageRank 算 法 公式 为 (2.1) : 


其 中 PR (pi) 是 pi 页 面 的 PageRank 值 ，n 是 所 有 页 面 的 数量 ，p 滥 不 同 的 网 页 p1、p2、p3，M (i) 是 p 链 入 网 页 的 集合 ，L () 是 p 链 出 网 页 的 数量 ，d 是 阻尼 系数 ， 任 意 时 刻 ， 用 户 到 达 某 页 面 后 并 继续 


向 后 浏览 的 概率 。 通 过 经 验 值 ，Google 设 置 d=0.85， 则 1-d=0.15 表 示 用 户 停止 点 击 随机 跳 到 新 URL 的 概率 ，d 的 取 值 范围 是 0<d<1。 


3. 构 造 实例 : 以 4 个 页 面 的 数据 为 例 


我 们 以 4 个 页 面 的 数据 为 例 ， 构 造 一 个 简单 的 PageRank 实 例 模 型 ， 如 图 2-2 所 示 。 


42-2 PageRank 构造 实例 


在 图 2-2 中 ，ID=1 的 页 面 链 向 页 面 2、3、4， 所 以 一 个 用 户 从 ID=1 的 页 面 跳 转 到 2、3、4 的 概率 各 为 1/3，ID=2 的 页 面 链 向 页 面 3 和 4， 所 以 一 个 用 户 从 ID=2 的 页 面 跳 转 到 3，4 的 概率 各 为 1/2，ID=3 的 
页 面 链 向 页 面 4， 所 以 一 个 用 户 从 ID=3 的 页 面 跳 转 到 4 的 概率 各 为 1，ID=4 的 页 面 链 向 页 面 2， 所 以 一 个 用 户 从 ID=4 的 页 面 跳 转 到 2 的 概率 各 为 1。 


下 面 我 们 开始 构建 PageRank 的 数据 模型 和 转移 矩阵 。 第 一 步 ， 通 过 网 页 的 链接 关系 ， 构 造 出 邻接 表 : 


MENOR 链接 


> 


标 页 面 
3,4 
4 


BWN 


第 二 步 ， 通 过 邻接 表 ， 构 建 邻接 矩阵 ( 方 阵 ) ， 其 中 列表 示 源 页 面 ， 行 表示 目标 页 面 。 


L1] DL 21 b, 3] E, 41 
0 0 


rmi 


第 三 步 ， 把 邻接 矩阵 ， 转 换 为 概率 矩阵 (转移 矩阵 ) 。 


[, 1] [, 2] [, 31 [, 4] 
0 


[1, ] 0 0 0 
I2, ] 173 0 0 1 
[3, ] 1/3 1/2 0 0 
[4, ] 1/3 1/2 1 0 


这 样 ， 通 过 网 页 的 链接 关系 ， 我 们 就 构造 出 了 概率 转移 矩阵 。 


2.2.3 ”R 语 言 单机 算法 实现 


下 面 我 们 用 R 语 言 实现 从 邻接 表 到 转移 矩阵 的 构建 过 程 ， 创 建 数据 文件 page.csv， 用 于 表示 网 页 的 邻接 表 。 


wwwN 


分 别 用 下 面 3 种 方式 实现 PageRank 模 型 ， 即 未 考虑 阻尼 系统 的 情况 ， 考 虑 阻尼 系统 的 情况 ， 直 接 用 R 的 矩阵 特征 值 函 数 计算 。 


1. 未 考虑 阻尼 系统 的 情况 


R 语 言 实现 如 下 : 


adjacencyMatrix«-function (pages) { # 构建 邻接 矩阵 

n«-max (apply (pages, 2, max) ) 

A «- matrix (0, n, n) 

for (i in 1: nrow (pages) ) A[pages[i, ]$dist, pages[i, ]$src]«-1 
A 


probabilityMatrix«-function (G) ( # 变换 概率 矩阵 
cs <- colSums (G) 

cs[cs==0] <- 1 

n <- nrow (G) 

A <- matrix (0, nrow (G) , ncol (G) ) 


for (iin 1: n) A[i, ] <- Ali, ] + Gli, ]/cs 

A 

} 

eigenMatrix<-function (G, iter=100) { # 递归 计算 矩阵 特征 值 
iter<-10 


n<-nrow (G) 

x <- rep (1, n) 

for (iin 1: iter) x «- G $*$ x 
x/sum (x) 


十 十 十 十 十 十 V 十 十 十 十 十 十 十 V 十 十 十 十 十 VV 


} 

# 运行 程序 

> pages<-read.table (file="page.csv", header=FALSE, sep=", ") + 读数 据 文件 到 内 存 
> names (pages) «-c ("src", "dist") ; pages # 设置 数据 的 header 
sro dist 


v 20 05Q(QNP 
ONDPPP 
Mods dS C9 IS COINS 


A«-adjacencyMatrix (pages) ; A + ARIRE 
bs 1] D 2] [, 31. [, 41 
0 0 0 0 


. 1 Ë 1 0 

» G«-probabilityMatrix (A) ; G # 概率 转移 矩阵 
Ls 1] E, 21 E, 31 [, 41 

di 0.0000000 0.0 
2, 0.3333333 0.0 
3e 0.3333333 0.5 
4, 0.3333333 0.5 
> gq«-eigenMatrix (G, 100) ; q 4 PageRank 值 
[, 1] 


Pooo 
ooro 


m 0.0000000 
2; 0.4036458 
3 0.1979167 
4, 0.3984375 


结果 解读 如 下 : 

:ID=1 的 页 面 ，PR 值 是 0， 因 为 没有 指向 ID=1 的 页 面 。 

“ID=2 的 页 面 ，PR 值 是 0.4， 权 重 最 高 ， 因 为 页 面 1 和 4 都 指向 页 面 2， 页 面 4 权重 较 高 ， 并 且 页 面 4 只 有 一 个 链接 指向 页 面 2， 权 重 传递 没有 损失 。 
:ID=3 的 页 面 ，PR 值 是 0.19， 虽 有 页 面 1 和 2 都 指向 了 页 面 3， 但 是 页 面 1 和 2 还 指向 其 他 页 面 ， 权 重 被 分 散 了 ， 所 以 ID=3 的 页 面 PR 并 不 高 。 


“ ID=4 的 页 面 ，PR 值 是 0.39， 权 重 很 高 ， 因 为 被 页 面 1，2，3 都 指向 了 。 
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从 上 面 的 结果 ， 我 们 发 现 ID=1 的 页 面 ，PR 值 是 0， 那 么 ID=1 的 页 面 ， 就 不 能 向 其 他 页 面 输出 权重 了 ， 计 算 就 会 不 合理 ! 所 以 ， 增 加 阻尼 系数 d， 修 正 没有 链接 指向 的 页 面 ， 保 证 页 面 的 最 小 PR 值 >0。 


2. 考 虑 阻尼 系统 的 情况 


这 里 增加 函数 dProbabilityMatrix。 


> dProbabilityMatrix«-function (G, d-0.85) { *OXIMAGUCEARMR, AEE A Ska] HOC 
* cs «- colSums (G) 

+ cs[cs--0] <- 1 

* n «- nrow (G) 

+ delta <- (1-d) /n 

* A «- matrix (delta, nrow (G) , ncol (G) ) 

+ 
十 
4 


for (i in 1: n) A[i, ] <- Ali, ] + d*G[i, ]/cs 

A 
H 
+ 运行 程序 
> pages«-read.table (file-"page.csv", header-FALSE, sep-", ") * 读数 据 文 件 到 内 存 
> names (pages) «-c ("src", "dist") # 设置 数据 的 header 
> A<-adjacencyMatrix (pages) ; A P 构建 邻接 矩阵 

DL, 1] D 21 [s 3] [, 41 
1, 0 0 0 0 
2, 1 0 0 1 
3, 1 1 0 0 
4, 1 1 1 0 
» G«-dProbabilityMatrix (A) ; G E MPRI, EER Mas OU 
L1] L2] L3] L4 


d 0.0375000 0.0375 0.0375 0.0375 

2, 0.3208333 0.0375 0.0375 0.8875 

3k 0.3208333 0.4625 0.0375 0.0375 

4, 0.3208333 0.4625 0.8875 0.0375 

> gq«-eigenMatrix (G, 100) ; q # PageRank 值 
| 

dy 0.0375000 

2, 0.3738930 

ET 0.2063759 

4, 0.3822311 


增加 阻尼 系数 后 ，ID= 1 的 页 面 ， 就 有 值 了 PR (1) = (1-d) /n= (1-0.85) /4=0.0375， 即 无 外 链 页 面 的 最 小 值 。 


" 
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3. 直 接 用 R 的 特征 值 计算 函数 


上 面 的 算法 ， 我 们 做 的 都 是 递归 计算 ， 通 过 多 次 循环 得 到 矩阵 的 特征 值 。R 语 言 本 身 提 供 了 直接 计算 特征 值 的 函数 ， 我 们 可 


calcEigenMatrix。 


以 直接 调用 ， 从 而 简化 代码 的 复杂 


度 。 下 面 增加 计算 特征 值 函数 


> calcEigenMatrix<-function (G) { + 直接 计算 矩阵 特征 值 
+ x <- Re (eigen (G) $vectors[, 1]) 
* x/sum (x) 
+} 
# 运行 程序 
> pages«-read.table (file-"page.csv", header-FALSE, sep-", 
» names (pages) «-c ("src", "dist") 
» A«-adjacencyMatrix (pages) ; A 
L11 L,21 D, 31 DL, 4 


0 0 
0 0 
T 0 

1 


1") # 读数 据 文 件 到 内 存 
# 设置 数据 的 header 
# 构建 邻接 矩阵 
0 
1 
0 
T. 0 
lityMatrix (A) ; G 

l, 1] [, 2] [, 31 L 
0375000 0.0375 0.0375 0.0375 
3208333 0.0375 0.0375 0.8875 
3208333 0.4625 0.0375 0.0375 
0.3208333 0.4625 0.8875 0.0375 
g«-calcEigenMatrix (G) ; 
0.0375000 0.3732476 0 


$o:iiTRéR[GA GIRL, MESE 

4] 
190. 
190. 
，] 0. 
，] 

q # PageRank 值 
.2067552 0.3824972 


直接 计算 矩阵 特征 值 ， 可 以 有 效 地 减少 循环 的 操作 ， 提 高 程序 运行 效率 。 


224 R 语 言 分 步 式 算法 实现 


使 用 PageRank 的 场景 大 都 是 基于 海量 数据 的 ， 通 常会 用 Hadoop 的 解决 方案 ， 通 过 分 步 式 并 行 算法 计算 出 每 个 页 面 的 得 


。 利 


R 语 言 ， 我 可 以 先 构建 出 分 步 式 算法 的 原型 ， 保 证 分 步 式 算法 的 结果 与 


单机 算法 的 结果 是 一 致 的 ， 从 而 总 结 出 分 步 式 算法 的 计算 公式 ， 再 用 Hadoop 的 MapReduce 进 行 和 


1.PageRank 算 法 分 步 式 原理 


PageRank 的 分 步 式 算法 原理 ， 简 单 来 讲 ， 就 是 通过 矩阵 计算 实现 并 行 化 。 我 们 直接 从 邻接 矩阵 开始 说 起 ， 对 于 Hadoop 来 


看 写 ， 从 而 达到 生产 环境 的 上 线 要 求 。 


说 需要 把 邻接 矩阵 的 列 按 数据 行 存储 ， 而 R 语 言 可 以 直接 用 


矩阵 对 象 表示 。 


[, 2] [, 3]  L 4] 
0.0375 0.0375 0.0375 
0.0375 0.0375 0.8875 
0.4625 0.0375 0.0375 
0.4625 0.8875 0.0375 


[, 1] 
0.0375000 
0.3208333 
0.3208333 
0.3208333 


rm 


ETR, ARRERA, fzRRMapReducefSigitASE, IBRIBEBUEUAtO Amap reduced, mapt 


从 而 计算 出 矩阵 特征 值 。Hadoop 的 MapReduce 计 算 过 程 如 


图 2-3 所 示 。 


图 2-3 PageRank 4j MapReduce T JE 3d 4 


对 于 Hadoop 的 map 过 程 ， 输 入 为 邻接 矩阵 和 pr 值 ; 输出 中 key 为 pr 的 行 号 ，value 为 邻接 矩阵 和 pr 值 的 乘法 求 和 公式 。 对 了 


于 数据 分 组 ，reduce 过 程 主要 | 


于 数据 计算 ， 让 map 和 reduce 循 环 迭 代 ， 


乘法 求 和 公式 ; 输出 中 key 为 pr 的 行 号 ，value 为 计算 的 结果 ， 即 pr 值 。 


2.R 语 言 程序 模拟 


我 们 通过 R 语 言 来 实现 这 个 程序 ， 把 矩阵 计算 分 解 为 nap 和 reduce 两 个 过 程 。 在 map 过 程 中 ， 把 数据 按 一 定 规则 切 分 成 多 块 ， 海 量 数 据 分 布 在 Hadoop 的 多 个 存储 节点 上 


仅 包 括 了 4 个 网 页 ， 我 把 数据 切 分 成 2 组 ， 模 拟 存储 在 2 个 Hadoop 节 点 上 。 


FHadoop 的 reduce 过 程 ， 输 入 中 key 为 pr 的 行 号 ，value 为 邻接 矩阵 和 pr 值 的 


于 模拟 。 本 节 使 


的 数据 集 


> map <- function (S0, node = "a") ( # map 过 程 函数 
* S «- apply (S0, 2, function (x) x/sum (x) ) 

t if (node == "a") 

十 S[, 1: 2] else S[, 3: 4] 

n 


} 


在 reduce 过 程 中 ， 数 据 从 多 个 map 节 点 汇总 到 reduce 节 点 ， 进 行 数据 合并 计算 。 通 过 R 语 言 ， 我 直接 在 reduce () 函数 内 部 完成 了 迭代 计算 的 过 程 。 而 对 完全 的 分 步 式 的 MapReduce 来 说 ,每 次 迭代 
都 要 包括 完成 的 map 过 程 和 reduce 过 程 。 


reduce <- function (A, B, a= 0.85, niter = 100) { 4 reduce 过 程 函数 
n «- nrow (A) 
q< rep (1, m) 
Ga<-a*A+ (1-a)/n* (A[A! 2 1] = 1) 
Gb <-a * B+ (1-a)/n* (B[B != 1] = 1) 


> 
+ 
+ 
+ 
+ 
+ for (i in 1: niter) { + 迭代 计算 

+ qa <- as.matrix (q[1: ncol (A) ]) 

十 qb <- as.matrix (q[ (ncol (A) + 1) : nl) 

H q <- Ga $*$ qa + Gb %*% qb 

+ } 

+ as.vector (q/sum (q) ) # 标准 化 PR 值 
二 


运行 程序 ， 进 行 100 次 和 迭代， 计算 矩阵 特征 值 (PR 值 ) ， 比 较 计 算 结果 ， 发 现 这 与 单机 的 计算 结果 是 一 致 的 。 


0 
# 初始 数据 矩阵 

> A <- map (S0, "a") d 矩阵 数据 分 组 

> B <- map (S0, "b") 

» reduce (A, B # 给 阵 数据 计算 

[1] 0.0375000 0.3732476 0.2067552 0.3824972 

3 .和 矩阵 的 计算 过 程 


对 于 每 次 迭代 计算 的 PR 值 ， 我 们 可 以 打印 出 来 ， 从 而 清楚 地 看 到 每 次 迭代 的 结果 。 把 reduce () 函数 的 代码 稍 加 修改 ， 增 加 原始 PR 值 输出 和 标准 化 的 PR 值 输出 。 


> reduce <- function (A, B, a= 0.85, niter = 100) { 
+ n<- nro (A) 
+ q« rep(l, n) 
+ Ga«-a*A-c (1-a)/n* (A[Al=1]=1) 
+ BH<-a*rB+ (1-a)/n* (B[B! =1] = 1) 
+ for (i in 1: niter) { 
* ga «- as.matrix (q[1: ncol (A) ]) 
* qb «- as.matrix (q[ (ncol (A) + 1) : n]) 
十 q <- Ga $*$ qa + Gb $*$ db 
T od 
+ print (q) # 原始 PR 值 
+ print (as.vector (q/sum (q) ) ) # 标准 化 的 PR 值 
+3} 
第 1 次 迭代 的 计算 结果 。 
> reduce (A, B, niter-1) # 原始 PR 值 
[s 1] 
[1, ] 0.1500000 
[2, ] 1.2833333 
[3, ] 0.8583333 
[4, ] 1.7083333 
[1] 0.0375000 0.3208333 0.2145833 0.4270833 4 标准 化 的 PR 值 
第 1 次 迁 代 时 ， 原 始 PR 值 的 矩阵 计算 公式 。 
0.0375000 0.0375 0.0375 0.0375 L 0.150000 
0.3208333 0.0375 0.0375 0.8875 * 1 = 1.283333 
0.3208333 0.4625 0.0375 0.0375 1 0.858333 
0.3208333 0.4625 0.8875 0.0375 1 1.708333 
第 2 次 迭代 的 计算 结果 。 
> reduce (A, B, niter=2) 
[, 1] 
[1, ] 0.1500000 
[2, ] 1.6445833 
[3, ] 0.7379167 
[4, ] 1.4675000 
[1] 0.0375000 0.4111458 0.1844792 0.3668750 
ERAR, ESSPRIBBSXEEELHSEAS X. 
0.0375000 0.0375 0.0375 0.0375 0.150000 0.150000 
0.3208333 0.0375 0.0375 0.8875 * 1.283333 - 1.6445833 
0.3208333 0.4625 0.0375 0.0375 0.858333 0.7379167 
0.3208333 0.4625 0.8875 0.0375 1.708333 1.4675000 
第 10 次 迭代 计算 结果 。 
> reduce (A, B, niter=10) 
[, 11 
[1, ] 0.1500000 
[2, ] 1.4955721 
[3, ] 0.8255034 
[4, ] 1.5289245 
[1] 0.0375000 0.3738930 0.2063759 0.3822311 
第 10 次 迭代 时 ， 标 准 化 PR 值 的 矩阵 计算 公式 。 
0.150000 0.0375000 
1.4955721 / (0.15+1.4955721+0.8255034+1.5289245) = 0.3738930 
0.8255034 0.2063759 
1.5289245 0.3822311 


在 了 解 PageRank 的 原理 后 ， 使 用 R 语 言 构建 PageRank 模 型 ， 是 非常 容易 的 。 实 际 应 用 中 ， 我 们 也 愿意 用 比较 简单 的 方式 建 模 、 验 证 后 ， 再 用 其 他 更 底层 的 语言 实现 企业 应 用 ! 


在 我 的 博客 中 还 有 一 些 进 阶 的 内 容 ， 介 绍 了 如 何 用 MapReduce 分 步 式 算法 来 实现 PageRank 模 型 ， 请 参考 文章 《PageRank 算 法 并 行 实现 》 (http://blog.fens.me/algorithm-pagerank- 


mapreduce/) 。 


如 何 用 R 语 言 编写 金融 算法 模型 ? 


http://blog.fens.me/finance-stock-ma/ 


移动 平均 线 (MA). 是 股市 中 最 常用 的 一 种 技术 分 析 方法 ， 用 来 在 大 行情 的 波动 段 找到 有 效 的 交易 信号 。 移 动 平均 线 不 仅 简单 ， 而 且 有 效 ， 对 股市 操作 具有 和 神奇 的 指导 作用 。 据 金融 从 业 人 员 说 ， 均 线 模 


型 有 效 地 打败 了 大 部 分 的 主观 策略 ， 是 炒股 、 炒 期 货 的 必 备 基本 工具 。 那 么 本 节 将 深入 研究 一 下 均线 模型 如 何在 股市 中 发 挥 作 用 。 


移动 平均 (moving average, MA) 线 是 以 道 .琼斯 的 “平均 成 本 概念 ”为 理论 基础 ， 采 用 统计 学 中 “移动 平均 ”的 原理 ， 将 一 段 时 期 内 的 股票 价格 平均 值 连 成 


线 ， 用 来 显示 股价 的 历史 波动 情况 ， 进 


而 反映 股价 指数 未 来 发 展 趋势 的 技术 分 析 方 法 。 它 是 道 氏 理论 的 形象 化 表述 。 在 技术 分 析 领 域 中 ， 移 动 平均 线 是 必 不 可 少 的 指标 工具 。 移 动 平均 线 的 计算 方法 就 是 求 连续 若干 天 的 收盘 价 的 算术 平均 ， 天 数 


就 是 MA 的 参数 。 


计算 公式 是 MA= (C1+C2+C3+C4+C5+.…+Cn) /n， 其 中 C 为 收盘 价 ，n 为 移动 平均 周期 数 。 例 如 ，5 日 移动 平均 价格 计算 方法 为 : 


MA5= (前 四 天 收盘 价 + 前 三 天 收盘 价 + 前 天 收盘 价 + 昨 天 收盘 价 + 今 天 收盘 价 ) /5 


移动 平均 线 依 时 间 长 短 可 分 为 三 种 ， 即 短期 移动 平均 线 、 中 期 移动 平均 线 、 长 期 移动 平均 线 。 短 期 移动 平均 线 一 般 以 5 日 或 10 日 为 计算 期 间 ， 中 期 移动 平均 线 大 多 以 30 日 、60 日 为 计算 期 间 ， 长 期 移动 


平均 线 大 多 以 100 日 和 200 日 为 计算 期 间 。 


移动 平均 线 根据 对 数据 的 处 理 方法 ， 又 可 分 为 3 种 。 


(1) 简单 移动 平均 线 (simple moving average, SMA) : 又 称 “ 算 术 移动 平均 线 ”， 是 指 对 特定 期 间 的 收盘 价 进行 简单 平均 化 的 意思 。 一 般 所 提 到 的 移动 平均 线 即 指 简单 移动 平均 线 ， 本 节 中 介绍 


的 算法 模型 ， 也 是 用 的 简单 移动 平均 线 。 


(2) 加 权 移动 平均 线 (weighted moving average, WMA) : 是 一 种 按时 间 进 行 加 权 运 算 的 移动 平均 线 。 时 间 越 近 ， 价 格 的 权重 越 大 。 计 算 方 式 是 基于 加 权 移 动 平 均线 日 数 ， 将 每 一 个 之 前 日 期 比重 


提升 。 每 个 价格 会 乘 以 一 个 权重 ， 最 新 的 价格 会 有 最 大 的 比重 ， 其 之 前 的 每 一 日 的 比重 将 会 递减 。 加 权 移动 平均 线 是 移动 平均 线 的 改良 。 


(3) 指数 平滑 移 线 (exponential moving average, EMA) : 是 以 指数 式 递减 加 权 的 移动 平均 。 各 数值 的 加 权 影 响 力 随时 间 而 指数 式 递减 ， 越 近期 的 数据 加 权 影 响 力 越 重 ， 但 较 旧 的 数据 也 给 


予 一 定 的 加 权 值 。 


在 交易 软件 日 K 线 图 中 ， 除 了 标准 的 价格 K 线 以 外 ， 通 常 还 有 4 条 线 ， 分 别 是 白 线 、 黄 线 、 紫 线 、 绿 线 ， 依 次 分 别 表示 5 日 、10 日 、20 
不 同 的 均线 模型 。 以 乐 视 网 (300104) 股票 日 K 线 图 为 例 ， 截 取 2012 年 8 月 到 2014 年 7 月 的 股价 数据 ， 如 图 2-4 所 示 。 


D 


和 60 日 移动 平均 线 。 通 过 这 4 条 线 与 价格 K 线 的 交叉 ， 就 可 以 形成 


势 性 比较 明显 。 


乐 视 网 ( 日 续 ) MA5: 43.39 MA10: 44.03 


利 


从 图 2-4 中 ， 我 们 看 到 乐 视 网 股价 最 低 价 是 13.91 元 ， 出 现在 2012 年 12 月 ; 最 高 价 55.50 元 ， 出 现在 2014 年 1 月 。 这 段 时 期 ， 乐 视 网 的 股价 一 路 震荡 向 上 ， 波 动 最 小 的 绿色 线 为 60 日 均线 平滑 的 股价 ， 趋 


MAGO: 41.11 
155.50 


图 2-4 。 乐 视 网 股票 日 氏 线 图 


均线 平滑 的 特点 ， 可 以 发 现 均 线 与 价格 K 线 会 有 交叉 ， 各 均线 之 间 也 有 交叉 ， 我 们 可 以 通过 这 些 交 叉 点 判断 交易 信号 。 


“ 黄金 交叉 ， 当 10 日 均线 由 下 往 上 穿越 20 日 均线 ，10 日 均线 在 上 ，20 日 均线 在 下 ， 其 交叉 点 就 是 黄金 交叉 ， 黄 金 交叉 是 多 头 的 表现 ， 出 现 黄金 交叉 后 ， 后 市 会 有 一 定 的 涨幅 空间 ， 这 是 进 场 的 最 佳 时 


机 。 


“ 死亡 交叉 ， 当 20 日 均线 与 10 日 平均 线 交 叉 时 ，20 日 均线 由 下 住 上 穿越 10 日 均线 ， 形 成 20 日 平均 线 在 上 ，10 日 均线 在 下 时 ， 其 交点 称 为 “死亡 交叉 ”，“ 死 亡 交 叉 ” 预 示 空 头 市 场 来 临 ， 股 市 将 下 跌 ， 
此 时 是 出 场 的 最 佳 时 机 。 


如 果 很 好 地 运用 移动 平均 线 理论 ， 再 掌握 行情 的 真正 趋势 ， 就 能 获取 可 观 利润 。 但 移动 平均 线 理论 也 有 局 限 性 ， 具 体 如 下 : 


2.3.3 


移动 平均 线 是 股价 定型 后 产生 的 图 形 ， 反 映 较 慢 ， 只 适用 于 日 间 交 易 ; 


移动 平均 线 不 能 反映 股价 在 当日 的 变化 及 成 交 量 的 大 小 ， 不 适用 于 日 内 交易 ; 


移动 平均 线 是 趋势 性 模型 ， 如 果 股 价 未 形成 趋势 ， 只 是 频繁 波动 ， 模 型 不 适用 。 


用 R 语 言 实现 均线 模型 


接 下 来 ， 我 们 利用 R 语 言 对 股票 数据 进行 操作 ， 实 现 一 个 均线 模型 的 实例 。 


1 


R 语 言 本 身 提供 了 丰富 的 金融 函数 工具 包 ，quantmod 包 就 是 最 常用 的 一 个 ， 不 过 quantmod 包 还 要 配合 时 间 序 列 包 zoo、 可 扩 


从 互联 网 下 载 数据 


zoo 包 和 xts 包 的 详细 使 用 可 以 参考 《R 的 极 客 理想 一 一 工具 篇 》 的 2.1 节 和 2.2 节 。 


我 们 首先 利用 quantmod 包 ， 从 互联 网 下 载 股票 数据 ， 并 以 CSV 格 式 保存 到 本 地 。 


++vyvvyvvvvvæ 


+ 
+} 
> 


+ 


+} 
> 
> 
> 
2 


加 载 工 具 包 

library (plyr) 
library (quantmod) 
library (TTR) 
library (ggplot2) 
library (scales) 


download«-function (stock, from-"2010-01-01") { # 下 载 数据 并 保存 到 本 地 
df«-getSymbols (stock, from-from, env-environment () , auto.assign-FALSE) # 下 载 数据 
names (df) «-c ("Open", "High", "Low", "Close", "Volume", "Adjusted") 

write.zoo (df, file-paste (stock, ".csv", sep-"") , sep-", ", quote-FALSE) # 保存 到 本 地 文件 
read«-function (stock) ( + 从 本 地 文件 读数 据 


as.xts (read.zoo (file-paste (stock, ".csv", sep-"") , header = TRUE, sep-", " 
format-"$Y-$m-$d") ) 


Stock«-"IBM" # 下 载 TBM 的 股票 行情 数据 
download (stock, from-'2010-01-01') 

IBM«-read (stock) + 把 数据 加 载 到 内 存 
class (IBM) # 查看 数据 类 型 


[1] "xts" "zoo" 


多 


head (IBM) + 查看 前 6 条 数据 
Open High Low Close Volume Adjusted 


2010-01-04 131.18 132.97 130.85 132.45 6155300 121.91 
2010-01-05 131.68 131.85 130.10 130.85 6841400 120.44 
2010-01-06 130.68 131.49 129.81 130.00 5605300 119.66 
2010-01-07 129.87 130.25 128.91 129.55 5840600 119.24 
2010-01-08 129.07 130.92 129.05 130.85 4197200 120.44 
2010-01-11 131.06 131.06 128.67 129.48 5730400 119.18 


展 的 时 间 序 列 包 xts、 指 标 计算 包 TTR 和 可 视 包 ggplot2 等 一 起 使 用 ， 关 于 


利用 quantmod 包 的 getSymbols () 函数 ， 默 认 会 通过 Yahoo 人 金融 的 开放 API 下 载 数据 ， 我 们 选择 1BM 的 股票 行情 数据 ， 从 2010-01-01 到 2014-07-09 的 4 年 多 的 日 间 交 易 数 据 。 数 据 类 型 为 xts 格 式 的 


时 间 序 列 ， 数 据 包 括 7 个 列 ， 以 日 期 做 索引 列 ， 其 他 6 列 分 别 为 开盘 价 (Open) 、 最 高 价 (High) 、 最 低 价 (Low) 、 收 盘 价 (Close) 、 交 易 量 (Volume) 、 调 整 价 (Adjusted) 。 


2. 实 现 简单 的 蜡烛 图 


> 


直接 使 用 quantmod 包 的 chartSeries () 函数 ， 我 们 可 以 画 出 可 视 化 效果 还 不 错 的 蜡烛 图 。 简 单 的 蜡烛 医 


， 如 图 


chartSeries (IBM) # 画 TBM 股 票 的 蜡烛 图 


2-5 所 示 。 


如 果 你 想 在 蜡烛 图 上 增加 一 些 技术 指标 也 是 非常 方便 的 ， 直 接 把 指标 函数 以 参数 传 给 chartSeries () 函数 就 行 了 ， 画 出 带 SMA、MACD、ROC 等 指标 的 蜡烛 图 ， 所 图 2-6 所 示 。 


IBM, TA = "addVo () ; addSMA () ; addEnvelope () ; addMACD () ; addROC () ") 


> chartSeries 3 
8 蜡烛 图 
3 


LL 


[2010-01-04/2014-07-09] 


图 2-5 ”蜡烛 图 


[2010-01-04/2014-07-09] 


Last 180 42 


图 2-6” 带 指标 的 蜡烛 


非常 简单 的 2 个 函数 ， 就 可 以 实现 股票 数据 的 可 视 化 。 当 然 ， 这 个 功能 是 封装 好 的 通用 的 函数 ， 如 果 我 们 要 自 定义 策略 模型 ， 就 需要 自己 写 代 码 来 实现 了 ， 比 如 自 定义 的 支持 量 机 (SVM) 分 类 器 模 
型 ， 不 过 本 节 不 讲 太 复杂 的 模型 ， 而 是 实现 均线 模型 。 


3. 自 定义 均线 


网 


通过 自 定义 的 方式 ， 我 们 就 可 以 脱离 quantmod 包 自由 发 挥 了 。 我 们 首先 需要 自 定义 均线 指标 : 
“日 期 时 间 序 列 为 索引 
“ 收盘 价 作 为 价格 指标 
. 不 考虑 成 交 量 以 及 其 他 维度 字段 
- 取 2010-01-01 至 2012-01-01 的 股票 的 行情 数据 


“ 画 出 价格 曲线 以 及 5 日 均线 、20 日 均线 、60 日 均线 


R 语 言 程序 实现 代码 ， 如 下 所 示 。 


ma«-function (cdata, mas-c (5, 20, 60) ) ( # 移动 平均 
ldata«-cdata 
for (m in mas) { 
ldata«-merge (ldata, SMA (cdata, m) ) 
} 
ldata<-na.locf (ldata, fromLast=TRUE) 
names (ldata) «-c ('Value', paste ('ma', mas, sep-'') ) 
return (ldata) 
} 
drawLine«-function (ldata, titie-"Stock MA", sDate-min (index (ldata) ) , eDate- 
max (index (ldata) ) , out-FALSE) ( # 画 出 均线 图 
g«-ggplot (aes (x-Index, y=Value) , data-fortify (ldata[, 1], melt-TRUE) ) 
g«-g*geom line () 
g«-g*geom line (aes (colour-Series) , data-fortify (ldata[, -1], melt-TRUE) ) 
g«-g*scale x date (labels-date format ("$Y-&m") , breaks-date breaks 
("2 months") , limits = c (sDate, eDate) ) 
g«-gixlab ("") + ylab ("Price") 4ggtitle (title) 


V++++ 二 二 二 二 V 


十 十 十 十 


if (out) ggsave (g, file-paste (titie, ".png", 
else g 


sep="") ) 


l n 

运行 程序 
cdata«-IBM['2010/2012']$Close 
title«-"Stock IBM" 
sDate«-as.Date ("2010-1-1") 
eDate«-as.Date ("2012-1-1") 


VVVVYsETEE GA GA 


> ldata«-ma (cdata, c (5, 20, 60) ) # 选择 滑动 平均 指标 
> drawLine (ldata, title, sDate, eDate) # 画图 ， 如 图 2-7 所 示 
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图 2-7 均线 图 


通过 自己 封装 的 移动 平均 函数 和 可 视 化 函数 ， 就 实现 了 与 交易 软件 中 类 似 的 日 K 线 图 和 多 条 均线 结合 的 可 视 化 输出 。 


4. 一 条 均线 的 交易 策略 


基于 上 面 的 定义 的 均线 函数 ， 我 们 就 可 以 设计 自己 的 交易 策略 模型 了 。 模 型 设计 思路 如 下 : 


(1) 以 股价 和 20 日 均线 的 交叉 ， 进 行 交易 信号 的 判断 。 


(2) 当 股 价 上 穿 20 日 均线 则 买 入 ， 下 穿 20 日 均线 则 卖 出 。 


画 出 股价 和 20 日 均线 图 ， 如 图 2-8 所 示 。 


> ldata<-ma (cdata, c (20) ) d 选择 滑动 平均 指标 
> drawLine (ldata, title, sDate, eDate) # 画图 
Stock IBM 
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图 2-8 20 日 均线 


以 散 点 覆盖 20 日 均线 ， 红 色 点 为 买 入 持 有 ， 蓝 色 点 为 卖 出 空仓 ， 如 图 2-9 所 示 。 


# 均线 图 + 散 点 
> drawPoint«-function (ldata, pdata, titie, sDate, eDate) { 


+  g«-ggplot (aes (x-Index, y-Value) , data-fortify (1data[, 1], melt-TRUE) ) 

+  g«-gtgeom line () 

+  g«-gtgeom line (aes (colour-Series) , data-fortify (1data[, -1], melt-TRUE) ) 

*  g«-gtgeom point (aes (x-Index, y-Value, colour-Series) , data-fortify (pdata, melt-TRUE) ) 

+  g«-gtscale x date (labels-date format ("$Y-$m") , breaks-date breaks ("2 months") , 
limits - c (sDate, eDate) ) 

+  g«-gixlab ("") + ylab ("Price") 4ggtitle (title) 

n 

+} M 

+ 散 点 数据 


> pdata<-merge (ldata$ma20 [which (ldata$Value-ldata$ma20>0) ], ldata$ma20 [which 
(1data$Value-ldata$ma20«0) ]) 

» names (pdata) «-c ("down", "up") 

» pdata«-fortify (pdata, melt-TRUE) 

> pdata«-pdata[-which (is.na (pdata$Value) ) , ] 

» head (pdata) 
Index Series Value 

1 2010-01-04 down 128.7955 


2 2010-01-05 down 128.7955 
3 2010-01-06 down 128.7955 
4 2010-01-07 down 128.7955 
5 2010-01-08 down 128.7955 
6 2010-01-11 down 128.7955 
> drawPoint (ldata, pdata, title, sDate, eDate) # 画图 ， 如 图 2-9 所 示 
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图 2-9 ”20 日 均线 交易 信号 


均线 的 部 分 


股价 和 20 日 均线 价格 做 比较 ， 把 股价 大 于 20 


蓝 色 表示 ， 股 价 小 于 20 


均线 的 部 分 


一 个 点 买 入 股票 ， 然 后 在 蓝 色 出 现 的 第 一 个 点 卖 出 


我 们 要 找 出 这 些 交 易 信 号 点 ， 做 量化 的 统计 ， 看 看 到 底 能 不 能 赚钱 ， 能 赚 多 少 钱 。 


红色 表示 。 我 们 看 到 图 


股票 ， 这 样 就 构成 了 交易 信号 ， 从 直观 看 上 去 的 感觉 还 是 不 错 的 。 


中 ， 蓝 色 点 和 红色 点 在 20 


日 均线 上 交 共 出现， 我 们 可 以 在 每 次 红色 出 现 的 第 


Signal«-function (cdata, pdata) { # 交易 信号 


tmpc-'' 


tdata«-ddply (pdata[order (pdata$Index) , ], . (Index, Series) , function (row) ( 


> 

+ 

+ 

+ if (row$Series==tmp) return (NULL) 
+ tmp<<-row$Series 
d 

n 

n 

十 


}) 


tdata<-data.frame (cdata[tdata$Index], op-ifelse (tdata$Series--'down', 


names (tdata) <-c ("Value", "op") 
return (tdata) 
+} 
> tdata<-Signal (cdata, pdata) 
> tdata<-tdata [which (as.Date (row.names (tdata) ) <eDate) , ] 
> head (tdata) 


Value op 
2010-01-04 132.45 B 
2010-01-22 125.50 S 
2010-02-17 126.33 B 
2010-03-09 125.55 S 
2010-03-11 127.60 B 
2010-04-08 127.61 S 
» nrow (tdata) # 交易 记录 
[1] 72 


Bs '$') ) 


统计 发 现 ， 一 共有 72 条 交易 记录 ， 买 卖 各 占 一 半 。 


接 下 来 ， 我 们 要 利 


交易 信号 的 数据 ， 进 行 模拟 交易 。 我 们 设 定 交 易 参数 ， 以 10 万 美元 为 本 金 ， 满 仓 买 入 或 卖 出 ， 手 续费 为 0 元 。 


# 模拟 交易 
> trade<-function (tdata, capital=100000, position=1, fee=0.00003) { 
# 交易 信号 ， 本 人 金 ， 持 仓 比例 ， 手 续费 比例 

amount<-0 + HERE 

cash<-capital # 现金 


ticks«-data.frame () 
for (i in 1: nrow (tdata) ) { 
row«-tdata[i, ] 
if (row$op--'B') { 
amount«-floor (cash/row$Value) 
cash«-cash-amount*row$Value 
} 


if (row$op=='S') { 
cash<-cash+amount*row$Value 
amount<-0 


} 


row$cash<-cash 
row$amount<-amount 
row$asset<-cash+amount*row$Value LÀ 
ticks«-rbind (ticks, row) 


} 
ticks$diff<-c (0, diff (ticks$asset) ) 


# 赚钱 的 操作 
rise«-ticks[c (which (ticks$diff>0) -1, which (ticksSdiff20) ) , ] 
rise«-rise[order (row.names (rise) ) , ] 


# 赔钱 的 操作 
fall«-ticks[c (which (ticks$diff«0) -1, which (ticks$diff«0) ) ] 
fall«-fall[order (row.names (fall) ) , ] 


+ 资产 总 值 差 


return (list ( 
ticks=ticks, 
rise-rise, 
fall-fall 
») 
$ 


resulti«-trade (tdata, 100000) 


V3RV EE ER E b B B GB b b GB ex ox ob éx& o à o4 ok à «o BR 4 RA RR 4x 4 44—- 


查看 每 笔 交 易 
head (resultl$ticks) 
Value op cash amount asset diff 
2010-01-04 132.45 B 0.25 755 100000.00 0.00 


2010-01-22 
2010-02-17 
2010-03-09 
2010-03-11 
2010-04-08 
PO8TSEE 


125 
126 
125 
127 
127 


.50 
433 
.55 
.60 
.61 


> head (resultl$rise) 


2010-03-11 
2010-04-08 
2010-07-22 
2010-08-12 
2010-09-09 
2010-11-16 
# 亏损 的 交易 


AT 
128. 
126. 
142. 


> head (resultl$fall) 
Value op 


2010-01-04 
2010-01-22 
2010-02-17 
2010-03-09 
2010-04-09 
2010-04-12 


通过 模拟 交易 ， 我 们 就 能 精确 地 算出 每 笔 交易 的 盈利 情况 了 。 这 其 


132. 
E255. 
126. 
125. 
128. 
128. 


45 
50 
33 
55 
76 
36 


w 


S 
B 
S 
B 
S 


94752.75 0 94752.75 -5247.25 
5.25 750 94752.75 0.00 
94167.75 0 94167.75 -585.00 
126.55 737 94167.75 0.00 
94175.12 0 94175.12 7.37 
cash amount asset diff 
126.55 737 94167.75 0.00 
94175.12 0 94175.12 7.37 
108.79 633 80797.30 0.00 
81322.69 0 81322.69 525.39 
120.40 632 79979.92 0.00 
90016.08 0 90016.08 10036.16 
cash amount asset diff 
0.25 755 100000.00 0.00 
94752.75 0 94752.75 -5247.25 
5.25 750 94752.75 0.00 
94167.75 0 94167.75 -585.00 
51.56 731 94175.12 0.00 
93882.72 0 93882.72 -292.40 


> tail (result1$ticks, 1) 
Value op 


cash amount 
2011-12-21 181.47 $S 96363.76 


asset 
0 96363.76 -3063.87 


中 ， 有 56 笔 交易 其 


diff 


实 是 亏损 的 ， 只 有 16 笔 交易 是 有 盈利 的 。 查 看 最 后 的 资金 情况 。 


最 后 ， 资 金 剩余 96363.76 美 元 ， 也 就 是 我 们 亏 了 3636.24 美 元 。 为 什么 


后 会 亏损 呢 ?” 中 间 的 大 波段 应 该 赚 到 了 足够 多 的 钱 。 通 过 资金 曲线 我 们 可 以 找到 亏损 的 原 


。 画 出 资金 曲线 ， 如 图 2-10 所 示 。 


股价 + 现金 流量 
drawCash«-function (ldata, adata) { 
y-Value) , data-fortify (ldata[, 1], melt-TRUE) ) 


g«-gtgeom line () 
g«-gt*geom line (aes (x-as.Date (Index) , 
(adata, melt-TRUE) ) 


# 
> 
+  g«-ggplot (aes (x-Index, 
4 
+ 


y=Value, colour=Series) , data=fortify 


+ g<-gtfacet grid (Series ~ ., scales = "free y") 

+  g«-g*scale y continuous (labels = dollar) `~ 

+  g«-gtscale x date (labels-date format ("$Y-&m") , breaks-date breaks ("2 months") , 
limits - c (sDate, eDate) ) 

+  g«-gixlab ("") + ylab ("Price") 4ggtitle (title) 

+ g 

[o 

+ 现金 流量 

> adata«-as.xts (resultl$ticks[which (result1$ticks$op=='S') , ]['cash']) 

> drawCash (ldata, adata) # 画图 
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2-10 20 日 均线 策略 现金 曲线 


ensa 


Series 


2-01 


我 们 把 股价 和 现金 流量 并 排放 置 ， 从 2010-09 开 始 均线 策略 开始 大 幅 赚钱 ， 到 2011-10 到 达 最 高 点 ， 并 且 超 过 了 本 金 ， 然 后 开始 下 滑 ， 截 至 2012-01 亏 损 3859.86 美 元 。 这 是 由 于 我 们 把 赚 到 的 利润 继续 


投资 ， 增 大 了 头寸 ， 以 至 于 2011 


这 样 就 完成 一 条 20 日 均线 的 交易 策略 模型 ， 并 


5. 二 条 均线 的 交易 策略 


一 条 均线 模型 ， 在 大 的 趋势 下 是 可 以 稳定 赚钱 的 


对 波动 的 敏感 性 。 


IBM 的 股票 做 了 测试 。 


底 的 震荡 市 让 模型 失效 ， 从 而 赔 了 更 多 的 钱 。 


， 但 由 于 一 条 均线 对 于 波动 非常 敏感 ， 如 果 小 波动 过 于 频繁 ， 不 仅 会 增加 交易 次 数 ， 而 且 会 让 模型 失效 。 然 后 ， 就 有 二 条 均线 的 策略 模型 ， 它 可 以 降低 


均线 


IR] 


2-11 所 示 。 


二 条 均线 策略 模型 ， 与 一 条 均线 模型 思路 类 似 ， 以 5 日 均线 价格 蔡 换 股价 ， 是 通过 5 日 均线 和 20 日 均线 交叉 来 进行 交易 的 。 我 们 首先 画 出 股价 5 


均线 和 20 


， 如 


> ldata«-ma (cdata, c (5, 20) ) 
> drawLine (ldata, title, sDate, eDate) 
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图 2-11 5 日 均线 和 20 日 均线 


以 散 点 覆盖 20 日 均线 ， 红 色 点 为 买 入 持 有 ， 紫 色 点 为 卖 出 空仓 ， 如 图 2-12 所 示 。 


+ 散 点 数据 
> 


pdata<-merge (ldata$ma20 [which (1data$ma5-ldata$ma20»0) ] ldata$ma20 [which (ldata$ma5- 
ldata$ma20«0) ]) 


Index Series 
2010-01-04 
2010-01-05 
2010-01-06 


2010-01-08 
2010-01-11 


drawPoint (ldata, pdata, title, sDate, eDate) 


1 
2 
3 
4 2010-01-07 
5 
6 
= 


down 
down 
down 
down 
down 
down 


Value 
128.7955 
128.7955 
128.7955 
128.7955 
128.7955 
128.7955 


names (pdata) «-c ("down", "up") 
pdata«-fortify (pdata, melt-TRUE) 
pdata«-pdata[-which (is.na (pdataSValue) ) , ] 
head (pdata) 


# 画图 ， 如 图 2-12 所 示 。 
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用 5 日 均线 和 20 日 均线 价格 做 比较 ， 把 5 日 均线 小 于 20 日 均线 的 部 分 用 紫色 表示 
每 次 红色 出 现 的 第 一 个 点 买 入 股票 ， 然 后 在 紫色 出 现 的 第 一 个 点 卖 出 股票 。 直 观看 上 去 与 一 条 均线 模型 类 似 ， 都 是 赚钱 的 。 


，5 日 均线 大 于 20 日 均线 的 部 分 用 


我 们 要 找 出 这 些 交 易 信号 点 ， 做 量化 的 统计 ， 看 看 到 底 能 不 能 赚钱 。 


242 5 日 均线 和 20 日 均线 交易 信号 图 


红色 表示 。 我 们 看 到 


图 中 ， 紫 色 点 和 红色 点 在 20 日 均线 上 交 共 出现。 同样 ， 我 们 可 以 在 


> tdata«-Signal (cdata, pdata) 


> tdata«-tdata[which (as.Date (row.names (tdata) ) «eDate) , ] 
> head (tdata) 
Value op 


2010-01-04 
2010-01-26 
2010-02-18 
2010-03-10 
2010-03-16 
2010-04-12 


132. 
125. 
TZ. 
t25; 
128. 
128. 


» nrow (tdata) 


[1] 36 


45 B 


o 
Ds] 
QU 0 Uo 


一 共有 36 条 交易 记录 ， 买 卖 各 占 一 


#， 比 一 条 均线 模型 少 了 36 笔 交易 。 


+ 模拟 交易 


> result2«-trade (tdata, 100000) 


+ 查看 每 笔 交易 


> head (result2$ticks) 


Value op cash amount asset diff 
2010-01-04 132.45 B 0.25 755 100000.00 0.00 
2010-01-26 125.75 S 94941.50 0 94941.50 -5058.50 
2010-02-18 127.81 B 106.48 742 94941.50 0.00 
2010-03-10 125.62 S 93316.52 0 93316.52 -1624.98 
2010-03-16 128.67 B 30.77 725 93316.52 0.00 
2010-04-12 128.36 5 93091.77 0 93091.77 -224.75 
# 盈利 的 交易 
> head (result2$rise) 

Value op cash amount asset diff 
2010-09-10 127.99 B 75.34 649 83140.85 0.00 
2010-11-18 144.36 S 93764.98 0 93764.98 10624.13 
2010-12-07 144.02 B 2.66 638 91887.42 0.00 
2011-02-23 160.18 S 102197.50 0 102197.50 10310.08 
2011-03-28 161.37 B 124.70 582 94042.04 0.00 
2011-05-20 170.16 S 99157.82 0 99157.82 5115.78 
UNDE LEE 
> head (result2$fall) 

Value op cash amount asset diff 
2010-01-04 132.45 B 0.25 755 100000.00 0.00 
2010-01-26 125.75 S 94941.50 0 94941.50 -5058.50 
2010-02-18 127.81 B 106.48 742 94941.50 0.00 
2010-03-10 125.62 S 93316.52 0 93316.52 -1624.98 
2010-03-16 128.67 B 30.77 725 93316.52 0.00 
2010-04-12 128.36 S 93091.77 0 93091.77 -224.75 


通过 模拟 交易 ， 我 们 精确 地 算出 每 笔 交易 的 盈利 情况 了 ， 有 26 笔 交易 是 亏损 的 ，16 笔 交易 是 有 盈利 的 。 


查看 最 后 的 资金 情况 。 
> tail (result2$ticks, 1) 

Value op cash amount asset diff 
2011-12-19 182.89 S 96828.9 0 96828.9 -3581.33 


利用 交易 信号 数据 ， 进 行 模拟 交易 。 我 们 设 定 交 易 参 数 ， 以 100000 美 元 为 本 金 ， 满 仓 买 入 或 卖 出 ， 手 续费 为 0， 传 入 交易 信号 。 最 后 ， 资 金 剩余 96828.9 美 元 , 亏 了 3171.1 美 元 。 查 看 资金 曲线 ， 如 图 2- 
13 所 示 。 
> adata«-as.xts (result2$ticks [which (result2$ticks$op=='S') , ]['cash']) 


> drawCash (ldata, adata) 


Price 


595,000 - TT - i 


Stock IBM 


$180 - 


$160 - 


$140 - 


$120 - 


1 —— cash 
$100,000 - dn dq 


$90,000 - 


` / 
$85,000 - | 一 
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图 2-13 5 日 均线 和 20 日 均线 策略 现金 曲线 


我 们 可 以 发 现 ， 虽 然 最 后 资金 也 是 赔 了 3171.1 美 元 ， 比 一 条 均线 策略 模型 赔 的 少 一 点 ， 但 二 条 均线 策略 模型 有 3 次 高 于 本 金 的 情况 ， 而 且 最 差 的 情况 也 比 一 条 均线 最 差 的 情况 要 好 。 如 果 我 们 在 获得 盈利 
后 ， 把 赚 到 的 钱 从 账户 取出 ， 只 保持 原来 本 金 的 继续 交易 ， 那 么 这 部 分 利润 就 是 可 以 锁定 了 。 


6. 对 比 两 个 模型 的 盈利 情况 


我 们 再 进一步 对 比 两 个 模型 的 盈利 情况 ， 找 出 两 个 模型 中 所 有 赚钱 的 交易 。 


# 盈利 的 交易 
> rise«-merge (as.xts (resultl$rise[1]) , as.xts (result2$rise[1]) ) 
> names (rise) «-c ("planl", "plan2") 
E 查看 数据 情况 
> rise 

Planl Plan2 
2010-03-11 127.60 NA 
2010-04-08 127.61 NA 
2010-07-22 127.47 NA 
2010-08-12 128.30 NA 
2010-09-09 126.36 NA 
2010-09-10 NA 127.99 
2010-11-16 142.24 NA 
2010-11-18 NA 144.36 
2010-12-07 NA 144.02 
2010-12-08 144.98 NA 
2011-02-22 161.95 NA 
2011-02-23 NA 160.18 
2011-03-25 162.18 NA 
2011-03-28 NA 161.37 
2011-05-16 168.86 NA 
2011-05-20 NA 170.16 
2011-06-21 166.22 NA 
2011-06-23 NA 166.12 
2011-08-02 178.05 NA 
2011-08-04 NA 171.48 
2011-09-14 167.24 NA 
2011-09-16 NA 172.99 
2011-09-22 168.62 NA 
2011-09-23 169.34 NA 
2011-10-18 178.90 NA 


2011-10-21 NA 181.63 


plan1 是 一 条 均线 模型 ，plan2 是 二 条 均线 模型 。plan1 比 plan2 多 了 6 次 交易 ， 但 从 中 可 以 发 现 ， 多 的 这 几 次 交易 是 由 于 对 波动 敏感 性 引起 的 ， 反 而 减少 了 趋势 行情 所 带 来 的 收益 。 


最 后 ， 我 们 画 出 2 个 模型 一 利 部 分 的 交易 区 | 间 。 


24 均线 图 + 交易 区 间 
> drawRange<-function (ldata, plan, titie-"Stock 2014", sDate-min (index (ldata) ) ， 
eDate-max (index (ldata) ) , out-FALSE) ( 


+  g«-ggplot (aes (x-Index, y-Value) , data-fortify (ldata[, 1], melt-TRUE) ) 

* g«-gtgeom line () 

+  g«-gigeom line (aes (colour-Series) , data-fortify (ldata[, -1], melt-TRUE) ) 

+  g«-gtgeom rect (aes (NULL, NULL, xmin-start, xmax-end, fill-plan) , ymin = yrng[1], 
ymax = yrng[2], data-plan) 

+  g«-géscale fill manual (values -alpha (c ("blue", "red") , 0.2) ) 

+  g«-g*scale x date (labels-date format ("$Y-&m") , breaks-date breaks 
("2 months") , limits - c (sDate, eDate) ) 

+  g«-gtxlab ("") + ylab ("Price") 4ggtitle (title) 

十 

+ if (out) ggsave (g, file-paste (titie, ".png", sep-"") ) 

+ elseg 

+} 

# AAE 


> yrng <-range (ldata$Value) 

> planl<-as.xts (resultl$rise[c (1, 2) ]) 

> planl«-data.frame (start-as.Date (index (planl) [which (planl$op--'B') ]) , end- 
as.Date (index (planl) [which (planl$op--'S') ]) , plan-'planl') 

» plan2«-as.xts (result2$rise[c (1, 2) ]) 

» plan2«-data.frame (start-as.Date (index (plan2) [which (plan2$op--'B') ]) , end- 
as.Date (index (Plan2) [which (plan2$op--'S') ]) , plan-'plan2') 

» plan«-rbind (planl) # planlé$$ 4 4E i 

> drawRange (ldata, plan, title, sDate, eDate) # 画图 


plan1 的 盈利 区 间 ， 如 图 2-14 所 示 。 


> Plan<-rbind (planl, plan2) # 合并 plan1 和 Plan2 的 盈利 区 间 
> drawRange (ldata, plan, title, sDate, eDate) # 和 画图 


plan1 和 plan2 同 时 存在 的 盈利 区 间 ， 如 图 2-15 所 示 。 
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图 2-14 单 均线 策略 的 盈利 区 间 
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从 盈利 区 间 我 们 可 以 看 到 ， 这 印证 了 一 条 均线 对 波动 敏感 性 的 问题 ， 二 条 均线 模型 是 对 一 条 均线 模型 的 优化 ， 这 样 我 们 就 实现 了 一 个 完整 均线 模型 的 实例 研发 。 


plani 


plan2 


7. 模 型 优化 


从 交易 的 角度 讲 ， 上 面 的 模型 还 不 能 算 完 成 ， 


因为 还 有 很 多 的 赔钱 交易 ， 要 进行 更 多 地 优化 ， 减 少 最 大 回 撤 ， 在 更 确定 的 时 机 做 多 、 反 向 做 空 等 。 模 型 优化 的 问题 ， 


篇 》 中 再 进行 详细 的 介绍 。 


看 起 来 均线 模型 是 如 此 简单 ， 但 实 盘 交 易 时 真能 在 趋势 行情 中 跑 赢 双 均线 (优化 ) 模型 ， 也 真 不 是 一 件 容易 的 事情 。 


如 果 按 照 我 所 介绍 的 方法 ， 赚 到 钱 的 朋友 ， 可 以 请 我 喝 杯 茶 ， 分 享 一 下 经 验 ; 


没有 赚 到 钱 的 朋友 ， 还 要 继续 努力 ， 总 有 一 天 可 以 实现 财富 自由 的 目标 的 。 


24 R 语 言 中 的 遗传 算法 


问题 


如 何 用 有 语言 进行 遗传 算法 的 计算 ? 


人 类 总 是 在 生活 中 摸索 规律 ， 把 规律 总 结 为 经 验 ， 再 把 经 验 传 给 后 人 ， 
了 下 来 ， 聪 明 的 科学 家 又 把 生物 进化 的 规律 ， 


2.4.1 


遗传 算法 是 一 种 
杂交 等 。 遗 传 算法 通 
搜索 过 程 ， 


遗传 算法 的 操作 


的 近似 解 。 这 个 过 程 会 导致 种 群 中 个 体 的 进化 ， 


如 果 从 生物 进化 的 角度 ， 我 们 可 以 如 下 理解 。 在 一 个 种 群 中 ， 
择 过 程 会 根据 新 个 体 的 适应 度 进行 保留 或 淘汰 ， 但 也 不 是 完全 以 适应 度 高 低 作为 导向 ， 如 果 单纯 选择 适应 度 高 的 个 体 可 能 会 产生 局 


后 ， 通 过 繁殖 过 程 ， 


计算 出 全 局 
使 用 适 者 生存 的 原则 ， 在 潜在 的 种 群 中 逐次 产生 一 个 近似 最 优 解 的 方案 ， 在 每 一 代 中 ， 根 据 个 体 在 问题 域 中 的 适应 度 值 和 从 自然 遗传 学 中 借鉴 来 的 再 造 方法 进行 个 体 选择 ， 产 生 一 个 新 


A Ri R 语 言 中 的 遗传 算法 


.fens.me/algorithm-ga- 


让 后 人 发 现 更 多 的 规律 ， 每 一 次 知识 的 传递 都 是 一 次 进化 的 过 程 ， 最 终 形成 了 人 类 的 智慧 。 


总 结 成 遗传 算法 ， 扩 展 到 了 更 广 的 领域 中 。 本 节 将 带 你 走 进 遗 传 算 法 的 世界 。 


总 结 


遗传 算法 介绍 


最 优 解 。 


得 到 的 新 个 体 比 原来 个 体 更 能 适应 环境 ， 就 像 自 然 界 中 的 改造 一 样 。 


部 最 优 的 种 群 ， 而 非 全 局 最 优 ， 


会 在 《R 的 极 客 理想 一 一 量化 投资 


二 条 均线 打 天 下 ， 不 说 是 东方 不 败 ， 也 至 少 是 独孤 求 败 。 


r/ 


自然 界 的 规律 ， 


解决 最 优化 的 搜索 算法 ， 是 进化 算法 的 一 种 。 进 化 算法 最 初 借鉴 了 达尔 文 的 进化 论 和 孟 德 尔 的 遗传 学 说 ， 从 生物 进化 的 一 些 现象 发 展 起 来 ， 这 些 现象 包括 遗传 、 基 
过 模仿 自然 界 生物 进化 机 制 ， 发 展 出 了 随机 全 局 搜索 和 优化 的 方法 。 它 是 一 种 高 效 、 并 行 、 全 局 搜索 的 方法 ， 


让 人 类 适 者 生存 地 活 


因 突变 、 自 然 选 择 和 
它 能 在 搜索 过 程 中 自动 获取 和 积累 有 关 搜 索 空间 的 知识 ， 并 自 适应 地 控制 


个 体 数量 已 经 有 一 定 规模 ， 为 了 进化 发 展 ， 通 过 选择 和 繁殖 产生 下 一 代 的 个 体 ， 其 中 繁殖 过 程 包括 交配 和 突变 。 根 据 适 者 生存 的 原则 ， 选 
这 个 种 群 将 不 会 再 进化 ， 称 为 早熟 。 之 


件 发 生 基因 突 


让 个 体 两 两 交配 产生 下 一 代 新 个 体 ， 上 一 代 个 体 中 优秀 的 基因 会 保留 给 下 一 代 ， 而 较 差 的 基因 将 被 个 体 另 一 半 的 基因 所 代替 。 最 后 ， 通 过 小 概率 寻 


下 一 代 个 体 ， 实 现 种 群 的 变异 进化 。 


经 过 这 一 系列 的 选择 、 交 配 和 突变 的 过 程 ， 产 生 的 新 一 代 个 体 将 不 同 于 初始 的 一 代 ， 并 一 代 一 代 向 增加 整体 适应 度 的 方向 发 展 ， 


渐 被 淘汰 掉 。 这 样 的 过 程 不 断 地 重复 : 每 个 个 体 被 评价 ， 计 算出 适应 度 ， 两 个 个 体 交 配 ， 然 后 突变 ， 产 生 第 三 代 。 周 而 复 始 ， 直 到 终止 条 件 满足 为 止 。 


遗传 算法 使 


需要 注意 很 多 问题 。 


过 突变 产生 新 的 


因为 最 好 的 个 体 总 是 更 多 地 被 选择 去 产生 下 一 代 ， 而 适应 度 低 的 个 体 逐 


(1) 遗传 算法 在 适应 度 函 数 选择 不 当 的 情况 下 有 可 能 收敛 于 局 部 最 优 ， 而 不 能 达到 全 ， 


局 最 优 。 


(2) 初始 种 群 的 数量 很 重要 ， 如 果 初 始 种 群 数量 过 多 ， 算 法 会 占用 大 量 系统 资源 ; 如 


果 初 始 种 群 数量 过 少 ， 算 法 很 可 能 忽略 掉 最 优 解 。 


(3) 对 于 每 个 解 ， 一 般 根据 实际 情况 进行 编码 ， 这 样 有 利于 编写 变异 函数 和 适应 度 函 数 。 


(4) 在 编码 过 的 遗传 算法 中 ， 每 次 变异 的 编码 长 度 也 影响 到 遗传 算法 的 效率 。 如 果 变 异 代码 长 度 过 长 ， 变 异 的 多 样 性 会 受到 限制 ; 如果 变异 代码 过 短 ， 变 异 的 效率 会 非常 低下 ， 选 择 适 当 的 变异 长 度 是 


提高 效率 的 关键 。 


(5) 变异 率 是 一 个 重要 的 参数 。 


(6) 对 于 动态 数据 ， 用 遗传 算法 求 最 优 解 比 较 困 难 ， 因 为 染色 体 种 群 很 可 能 过 
早 收敛 。 其 中 一 种 是 所 谓 触发 式 超 级 变异 ， 就 是 当 染 色 体 群 体 的 质量 下 降 (彼此 的 


多 样 性 。 


(7) 选择 过 程 很 重要 ， 但 交叉 和 变异 的 
过 程 所 造成 的 更 新 ， 对 于 初期 的 种 群 来 说 ， 交 叉 几 平等 效 于 一 个 


Iml 


地 收敛 ， 而 对 以 后 变化 了 的 数据 不 再 产生 变化 。 对 于 这 个 问题 ， 研 究 者 提出 了 一 些 方法 增加 基因 的 多 样 性 ， 从 而 防止 过 
区 别 减 少 ) 时 增加 变异 概率 ; 另 一 种 叫 随 机 外 来 染色 体 ， 是 偶尔 加 入 一 些 全 新 的 随机 生成 的 染色 体 个 体 ， 从 而 增加 染色 体 


要 性 存在 争议 。 一 种 观点 认为 交叉 比 变异 更 重要 ， 因 为 变异 仅仅 是 保证 不 丢失 某 些 可 能 的 解 ; 而 另 一 种 观点 则 认为 交叉 过 程 的 作用 只 不 过 是 在 种 群 中 推广 变异 


F 常 大 的 变异 率 ， 而 这 么 大 的 变异 很 可 能 影响 进化 过 程 。 


(8) 遗传 算法 很 快 就 能 找到 良好 的 解 ， 即 使 是 在 很 复杂 的 解 空间 中 。 


(9) 遗传 算法 并 不 一 定 总 是 最 好 的 优化 策略 ， 优 化 问题 要 具 


体 情况 具体 分 析 。 所 以 在 使 用 遗传 算法 的 同时 ， 也 可 以 尝试 其 他 算法 ， 互 相 补 充 ， 甚 至 根本 不 用 遗传 算法 。 


(10) 遗传 算法 不 能 解决 那些 “大 海 捞 针 ”的 问题 ， 所 谓 “大 海 捞 针 ”问题 就 是 没有 一 个 确切 的 适应 度 函 数 表征 个 体 好 坏 的 问题 ， 使 得 算法 的 进化 失去 导向 。 


(11) 对 于 任何 一 个 具体 的 优化 问题 ， 调 节 遗 传 算法 的 参数 可 能 会 有 利于 更 好 、 更 快 地 收敛 ， 这 些 参 数 包括 个 体 数 目 、 交 叉 率 和 变异 率 。 例 如 ， 太 大 的 变异 率 会 导致 丢失 最 优 解 ， 而 过 小 的 变异 率 会 叶 


致 算法 过 早 收敛 于 局 部 最 优 解 。 对 于 这 些 参数 的 选择 ， 现 在 还 没有 实用 的 上 下 限 。 


(12) 适应 度 函 数 对 于 算法 的 速度 和 效果 也 很 重要 。 


遗传 算法 的 应 用 领域 包括 计算 机 自动 设计 、 生 产 调度 、 电 路 设计 、 游 戏 设计 、 机 器 人 学 习 、 模 糊 控制 、 时 间 表 安排 、 神 经 网 络 训练 等 。 然 而 ， 我 准备 把 遗传 算法 应 用 到 金融 领域 ， 比 如 回 测 系统 的 参数 
寻 优 方案 ， 我 会 在 《R 的 极 客 理想 一 一 量化 投资 篇 》 中 介绍 有 关 人 金融 领域 的 算法 解决 方案 。 


242 ”遗传 算法 原理 


在 遗传 算法 里 ， 优 化 问题 的 解 被 称 为 个 体 ， 它 表示 为 一 个 变量 序列 ， 叫 做 染色 体 或 者 


基因 串 。 染 色 体 一 般 被 表达 为 简单 的 字符 串 或 数字 串 ， 也 有 其 他 表示 法 ， 这 一 过 程 称 为 编码 。 首 先 要 创建 种 群 ， 算 


法 随机 生成 一 定数 量 的 个 体 ， 有 时 候 也 可 以 人 工 干预 这 个 过 程 进行 ， 以 提高 初始 种 群 的 质量 。 在 每 一 代 中 ， 每 一 个 个 体 都 被 评价 ， 并 通过 计算 适应 度 函 数 得 到 一 个 适应 度数 值 。 种 群 中 的 个 体 被 按照 适应 度 


排序 ， 适 应 度 高 的 在 前 面 。 


接 下 来 ， 是 产生 下 一 代 个 体 的 种 群 ， 通 过 选择 过 程 和 繁殖 过 程 完 成 。 


选择 过 程 是 根据 新 个 体 的 适应 度 进行 的 ， 但 同时 并 不 意味 着 完全 的 以 适应 度 高 低 作为 导向 ， 因 为 单纯 选择 适应 度 高 的 个 体 将 可 能 导致 算法 快速 收敛 到 局 部 最 优 解 而 非 全 局 最 优 解 ， 我 们 称 之 为 早熟 。 作 
为 折 中 ， 遗 传 算法 依据 原则 : 适应 度 越 高 ， 被 选择 的 机 会 越 高 ， 而 适应 度 低 的 ， 被 选择 的 机 会 就 低 。 初 始 的 数据 可 以 通过 这 样 的 选择 过 程 组 成 一 个 相对 优化 的 群体 。 


繁殖 过 程 表示 被 选择 的 个 体 进入 交配 过 程 ， 包 括 交 配 (crossover) 和 突变 (mutation) ， 交 配对 应 算法 中 的 交叉 操作 。 一 般 的 遗传 算法 都 有 一 个 交配 概率 ， 范 围 一 般 是 0.6~1， 这 个 交配 概率 反映 两 个 
被 选中 的 个 体 进 行 交配 的 概率 。 例 如 ， 交 配 概率 为 0.8， 则 80% 的 “夫妻 ”个 体会 生育 后 代 。 每 两 个 个 体 通过 交配 产生 两 个 新 个 体 ， 代 蔡 原 来 的 “ 老 ”个 体 ， 而 不 交配 的 个 体 则 保持 不 变 。 交 配 过 程 ， 父 母 的 
染色 体 相互 交换 ， 从 而 产生 两 个 新 的 染色 体 ， 第 一 个 个 体 前 半 段 是 父亲 的 染色 体 ， 后 半 段 是 母亲 的 ， 第 二 个 个 体 则 正好 相反 。 不 过 这 里 指 的 半 段 并 不 是 真正 的 一 半 ， 分 段 的 位 置 叫做 交配 点 ， 也 是 随机 产生 


的 ， 可 以 是 染色 体 的 任意 位 置 。 


突变 过 程 ， 表 示 通 过 突变 产生 新 的 下 一 代 个 体 。 一 般 遗 传 算法 都 有 一 个 固定 的 突变 常数 ， 又 称 为 变异 概率 ， 通 常 是 0.1 或 者 更 小 ， 这 代表 变异 发 生 的 概率 。 根 据 这 个 概率 ， 新 个 体 的 染色 体 随机 地 突变 ， 


通常 就 是 改变 染色 体 的 一 个 字 节 (0 变 到 1， 或 者 1 变 到 0) 。 


遗传 算法 实现 将 不 断 地 重复 这 个 过 程 : 每 个 个 体 被 评价 ， 计 算出 适应 度 ， 两 个 个 体 交 配 ， 然 后 突变 ， 产 生 下 一 代 ， 直 到 终止 条 件 满足 为 止 。 一 般 终止 条 件 有 以 下 几 种 : 


“ 进化 次 数 限制 。 


“ 计算 耗费 的 资源 限制 ， 如 计算 时 间 、 计 算 占用 的 CPU、 内 存 等 。 


“个体 已 经 满足 最 优 值 的 条 件 ， 即 最 优 值 已 经 找到 。 


: 当 适 应 度 已 经 达到 饱和 ， 继 续 进化 不 会 产生 适应 度 更 好 的 个 体 。 


”人 为 干预 。 


满足 终止 条 件 


终止 


2-16 ”遗传 算法 实现 思路 


算法 实现 思路 ， 如 图 2-16 所 示 。 在 图 2-16 中 ， 算 法 实现 过 程 为 : 


(1) 创建 初始 种 群 


(2) 循环 : 产生 下 一 代 
(3) 评价 种 群 中 的 个 体 适 应 度 


(4) 定义 选择 的 适应 度 函 数 


(5) 改变 该 种 群 (交配 和 变异 ) 
(6) 返回 第 二 步 


(7) 满足 终止 条 件 结束 


243 R 语 言 中 的 遗传 算法 


本 节 的 系统 环境 是 : 
* Windows 7 64bit 
“及 : 3.1.1 x86. 64-w64-mingw32/x64 (64-bit) 


一 个 典型 的 遗传 算法 要 求 一 个 基因 表示 的 求解 域 ， 以 及 一 个 适应 度 函 数 来 评价 解决 方案 。 


遗传 算法 的 参数 ， 通 常 包 括 以 下 几 个 。 

- 种 群 规模 (Population) ， 即 种 群 中 米色 体 个 体 的 数目 。 

“ 类 色 体 的 基因 个 数 (Size) ， 即 变量 的 数目 。 

“ 交配 概率 (Crossover) ， 用 于 控制 交叉 计算 的 使 用 频率 。 交 叉 操 作 可 以 加 快 收 伐 ， 使 解 达到 最 有 项 望 的 最 优 解 区 域 ， 因 此 一 般 取 较 大 的 交叉 概率 ， 但 交叉 概率 太 高 也 可 能 导致 过 早 收敛 。 
“ 变异 概率 (Mutation) ， 用 于 控制 变异 计算 的 使 用 频率 ， 决 定 了 遗传 算法 的 局 部 搜索 能 力 。 


:中止 条 件 (Termination) ， 结 束 的 标志 。 


在 R 语 言 中 ， 有 一 些 现成 的 第 三 方 包 已 经 实现 的 遗传 算法 ， 我 们 可 以 直接 使 用 。 
“ mcga 包 ， 多 变量 的 遗传 算法 ， 用 于 求解 多 维 函 数 的 最 小 值 ， 在 大 范围 的 搜索 空间 中 ， 效 率 非 常 高 。 

“ genalg 包 ， 多 变量 的 遗传 算法 ， 用 于 求解 多 维 泡 数 的 最 小 值 ， 提 供 数 据 可 视 化 的 功能 。 

“ rgenoud 包 ， 复 杂 的 遗传 算法 ， 将 遗传 算法 和 衍生 的 拟 牛 顿 算法 结合 起 来 ， 可 以 求解 复杂 函数 的 最 优化 化 问题 。 
“ gafit 包 ， 利 用 遗传 算法 求解 一 维 另 数 的 最 小 值 。 不 支持 R 3.1.1 的 版 本 。 

| GALGO 包 ， 利 用 遗传 算法 求解 多 维 函 数 的 最 优化 解 。 不 支持 R 3.1.1 的 版 本 。 

本 节 将 介绍 mcga 包 和 genalg 包 的 遗传 算法 的 使 用 。 


1.mcga 包 


我 们 使 用 mcga 包 的 mcga () 函数 ， 可 以 实现 多 变量 的 遗传 算法 。mcga 包 是 一 个 遗传 算法 的 工具 包 ， 主 要 解决 实 值 优化 的 问题 。 它 使 用 变量 值 表示 基因 序列 ， 而 不 是 字 节 码 ， 因 此 不 需要 编 解码 的 处 
。mcga 实 现 了 遗传 算法 的 交配 和 突变 的 操作 ， 并 且 可 以 进行 大 范围 和 高 精度 的 搜索 空间 的 计算 ， 算 法 的 主要 缺点 是 使 用 了 256 位 的 一 元 字母 表 。 首 先 ， 安 装 mcga 包 。 


> install.packages ("mcga") 
> library (mcga) 


查看 mcga () 函数 的 定义 。 


> mcga 
function (popsize, chsize, crossprob = 1, mutateprob = 0.01, elitism = 1, minval, 
maxval, maxiter = 10, evalFunc) 


到 


其 中 各 参数 意义 如 下 : popsize 是 个 体 数量 ， 即 染色 体 数目 ; chsize 是 基因 数量 ， 限 参数 的 数量 ; crossprob 是 交配 概率 ， 默 认为 1.0; mutateprob 是 突变 概率 ， 默 认为 0.01; elitism 是 精英 数量 ， 直 接 复 制 


下 一 代 的 染色 体 数目 ， 默 认为 1; minval 是 随机 生成 初始 种 群 的 下 边界 值 ; maxval 是 随机 生成 初始 种 群 的 上 边界 值 ; maxiter 是 繁殖 次 数 ， 即 循环 次 数 ， 默 认为 10; evalFun< 是 适应 度 函数 ， 用 于 给 个 体 


进行 评价 。 


接 下 来 ， 我 们 给 出 一 个 优化 的 问题 ， 通 过 mcga () 函数 ， 计 算 最 优化 的 解 。 


题目 1: 设 f (X) = (x1-5) 2+ (x2-55) 2+ (x3-555) 2+ (x4-5555) 2+ (xs-55555) 2， 计 算 f (x) 的 最 小 值 ， 其 中 x1，xz，x3，x4，x5 为 5 个 不 同 的 变量 。 


从 直观 上 看 ， 如 果 想 得 到 f (x) 的 最 小 值 ， 其 实 当 x1=5，x2=55，x3=555，x4=5555，x5=55555 时 ，f (x) =0 为 最 小 值 。 如 果 使 用 穷 举 法 ， 通 过 循环 的 方法 找到 这 5 个 变量 估计 会 很 费时 ， 这 里 就 不 


做 测试 了 。 下 面 我 们 看 看 遗传 算法 的 运行 情况 。 


# 定义 适应 度 函 数 
> f<-function (x) { 
return ( (x[1]-5) ^2 + (x[2]-55) ^2 + (x[3]-555) ^2 + (x[4]-5555) ^2 + (x[5]-55555) ^2) 


运行 遗传 算法 
m <- mcga ( popsize-200, 
chsize-5, 


l 

# 

条 

+ 

+ minval=0.0, 

+ maxval=999999, 
+ maxiter=2500, 

+ crossprob=1.0, 

+ mutateprob=0.01, 
+ evalFunc=f) 

# 最 优化 的 个 体 结果 

> print (m$population[1, ]) 

[1] 5.000317 54.997099 554.999873 5555.003120 55554.218695 
# 执行 时 间 

> m$costs[1] 

[1] 


1] 3.6104556 


我 们 得 到 的 最 优化 的 结果 为 X1=5.000317，x2=54.997099，x3=554.999873，x4=5555.003120，x5=55554.218695， 和 我 们 预期 的 结果 非常 接近 ， 而 且 耗 时 只 有 3.6 秒 。 这 个 结果 是 非常 令 人 满意 


的 。 而 如 果 使 用 穷 举 法 ， 时 间 复 杂 度 为 O (n^5) ， 估 计 没 有 5 分 钟 肯定 算 不 出 来 。 


Lr 


当然 ， 算 法 执行 的 时 间 和 精度 ， 都 是 通过 参数 进行 配置 的 。 如 果 增 大 个 体 数目 或 循环 次 数 ， 一 方面 会 增加 算法 的 计算 时 间 ， 另 一 方面 结果 也 可 能 变 得 更 精准 。 所 以 ， 在 实际 的 使 用 过 程 中 ， 需 要 根据 一 
定 的 经 验 调整 这 几 个 参数 。 


2.genalg 包 


我 们 使 用 genalg 包 的 rbga () 函数 ， 也 可 以 实现 多 变量 的 遗传 算法 。genalg 包 不 仅 实现 了 遗传 算法 ， 还 提供 了 遗传 算法 的 数据 可 视 化 ， 让 用 户 从 更 直观 的 角度 理解 算法 。genalg 包 会 生成 默认 的 可 视 
化 图 ， 包 括 每 次 迭代 的 最 优 评价 值 ， 表 示 遗 传 算法 的 计算 进度 。 直 方 图 显 出 了 基因 选择 的 频率 ， 即 基因 在 当前 个 体 中 被 选择 的 次 数 。 参 数 图 表示 评价 函数 和 变量 值 ， 非 常 方便 地 看 到 评价 函数 和 变量 值 的 相 
关 关系 。 


[ 


首先 ， 安 装 genalg 包 。 


> install.packages ("genalg") 
» library (genalg) 


查看 rbga () 函数 的 定义 。 


> rbga (stringMin-c () , stringMax-c () , 
suggestions-NULL, 
popSize-200, iters-100, 
mutationChance-NA, 
elitism-NA, 
monitorFunc-NULL, evalFunc-NULL, 
showSettings-FALSE,  verbose-FALSE) 


参数 说 明 : 

“stringMin， 设 置 每 个 基因 的 最 小 值 。 

“stringMax， 设 置 每 个 基因 的 最 大 值 。 

. suggestions， 建 议 染 色 体 的 可 选 列表 。 

“ popSize， 个 体 数量 ， 即 染色 体 数 目 ， 默 认为 200。 

' iters ， 选 代 次 数 ， 默 认为 100。 

mutationChance， 突 变 机 会 ， 默 认为 1/ (size+1) ， 它 影响 收 伊 速 度 和 搜索 空间 的 探测 ， 低 机 率 导 致 更 快 收敛 ， 高 机 率 增加 了 搜索 空间 的 跨度 。 
“ clitism， 精 英 数量 ， 默 认为 20%， 直 接 复制 到 下 一 代 的 染色 体 数目 。 

“ monitorFunc， 监 控 函 数 ， 每 产生 一 代 后 运行 。 

“evalFunc， 适 应 度 函 数 ， 用 于 给 个 体 进 行 评 价 。 

- showSettings ， 打 印 设置 ， 默 认为 false。 

' vetbose， 打 印 算法 运行 日 志 ， 默 认为 false。 

接 下 来 ， 我 们 给 定 一 个 优化 的 问题 ， 通 过 rbga () 函数 ， 计 算 最 优化 的 解 。 


题目 2: iO nce hx-Inx|， 计 算 f (x) 的 最 小 值 ， 其 中 x1，x2 为 2 个 不 同 的 变量 。 


从 直观 上 看 ， 如 果 想 得 到 f (x) 的 最 小 值 ， 其 实 当 x1=ve=1.648721，x2=Innt=1.14473 时 ,f(x) =0 为 最 小 值 。 同 样 ， 如 果 使 用 穷 举 法 ， 通 过 循环 的 方法 找到 这 2 个 变量 ， 估 计 会 很 费时 的 ， 我 也 不 做 
测试 了 。 下 面 我 们 看 看 rbga () 函数 的 遗传 算法 的 运行 情况 。 


> f«-function (x) { 
return (abs (x[1]-sqrt (exp (1) ) ) *abs (x[2]-log (pi) ) ) 


} 
E 定义 监控 函数 
> monitor «- function (obj) { 
xlim = c (obj$stringMin[1], obj$stringMax[1]) ; 
ylim = c (obj$stringMin[2], obj$stringMax[2]) ; 
plot (obj$population, xlim-xlim, ylim-ylim, xlab-"sqrt (exp (1) ) ", ylab-"log (pi) ") ; 


m2 = rbga (c (1, 1) , 
e€3,. 3) 5 
popSize-100, 
iters-1000, 
evalFunc-f, 
mutationChance-0.01, 
verbose-TRUE, 
monitorFunc-monitor 


-ttt-4x4x4—-VGa— 


+ 
Testing the sanity of parametershttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Not showing GA settingshttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Starting with random values in the given domainshttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Starting iteration 1 T 
Calucating evaluation valueshttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... http://www.hzcourse.com/resource/readBoc 
Sending current state to rgba.monitor () http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Creating next generationhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
sorting resultshttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
applying elitismhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
applying crossoverhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... 


applying mutationshttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... 2 mutations applied 
Starting iteration 2 
Calucating evaluation valueshttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... http://www.hzcourse.com/resource/readBoc 


Sending current state to rgba.monitor () http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Creating next generationhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 

sorting resultshttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... 

applying elitismhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 

applying crossoverhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 


applying mutationshttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... 4 mutations applied 
Starting iteration 3 
Calucating evaluation valueshttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... http://www.hzcourse.com/resource/readBoc 


# 省 略 输出 http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/OEBPS/Text/ . . . 


程序 运行 截图 ， 如 图 2-17 所 示 。 


代 、 


El Rterm (64-bit) 
sorting results... XC guys 至 让 小 
applying elitism... 
applying crossover... 
applying mutations... 2 nutations applied 


Starting iteration 916 

alucating evaluation values... . 
Sending current state to rgba.monitor(?... 
reating next generation... 

sorting results... 

applying elitism... 

applying crossover... 

applying mutations... 3 mutations applied 
Starting iteration 917 

alucating evaluation values... co 
Sending current state to rgba.nonitor(5... 
reating next generation... 

sorting results... 

applying elitism... 

applying crossover... 

applying mutations... 3 nutations applied 
Starting iteration 918 
Calucating evaluation values... 
Sending current state to rgba.nonitor(D... 
Creating next generation... 


sorting results... T 


applying elitism... - Š 20 
applying crossover... sqrt(exp(1)) 


applying mutations... 2 mutations applied 


图 2-17 rbga () 函数 的 算法 执行 


需要 注意 的 是 ， 程 序 在 要 命令 行 中 运行 ， 如 果 在 Rstudio 中 运行 ， 会 出 现下 面 的 错误 提示 。 


Error in get (name, envir = asNamespace (pkg) , inherits = FALSE) 
object 'rversion' not found 
Graphics error: Error in get (name, envir = asNamespace (pkg) , inherits = FALSE) 


object 'rversion' not found 


我 们 迭代 1000 次 后 ， 查 看 计算 结果 。 


t 计算 结果 
> m2$population[1, ] 
[1] 1.650571 1.145784 


得 到 的 最 优化 的 结果 为 X1=1.650571，x2=1.145784， 非 常 接近 最 终 的 结果 。 另 外 ， 我 们 可 以 通过 genalg 包 的 可 视 化 功能 ， 看 到 迭代 过 程 的 每 次 的 计算 结果 。 下 面 截图 


分 别 对 应 第 1 次 迁 代 、 第 10 次 迁 


第 200 次 迭代 和 第 1000 次 挝 代 的 计算 结果 。 从 图 2-18 中 可 以 看 出 ， 随 着 迭代 次 数 的 增加 ， 优 选 出 的 结果 集 变 得 越 来 越 少 ， 而 且 越 来 越 精准 。 


除了 可 以 对 算法 进行 可 视 追 踪 ，rbga 包 还 提供 了 3 个 用 于 分 析 效果 的 可 视 化 图 表 ， 分 别 是 默认 | 


、 直 方 图 和 参数 


。 用 R 实 现 默认 图 的 输出 ， 如 图 2-19 所 示 。 


D 
D 


> plot (m2) 


默认 图 用 于 描述 遗传 过 程 的 进展 情况 ，X 轴 为 迭代 次 数 ，Y 轴 为 评价 值 ， 评 价值 越 接 近 于 0 越 好 。 在 迭代 1000 次 后 ， 基 本 找到 了 精确 的 结果 。 


R 实 现 直方 图 输出 ， 如 图 2-20 所 示 。 


> plot (m2, type-'hist') 
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248 ”遗传 算法 的 数据 可 视 化 
直方 图 用 于 描述 对 染色 体 的 基因 选择 频率 ， 即 一 个 基因 在 染色 体 中 被 选择 的 次 数 。 当 变量 x1 在 1.65 区 域 时 ， 被 选择 超过 80 次 ， 当 变量 x2 在 1.146 区 域 时 ， 被 选择 超过 了 80 次 。 通 过 直方 图 ， 我 们 可 以 看 
出 更 优秀 的 基因 被 留 给 了 后 代 。 
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图 2-19 ”默认 图 输出 
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图 2-20 直方 图 输出 


用 R 实 现 参数 图 输出 ， 如 图 2-21 所 示 。 


> plot (m2, type-'vars') 


参数 图 用 于 描述 评价 函数 和 变量 的 值 之 间 的 相关 关系 。 对 于 变量 x1， 评 价值 越 小 ， 变 量 值 越 准确 ， 能 大 概 看 出 相关 关系 ， 但 相关 关系 不 明显 。 对 于 x2， 看 不 出 相关 关系 。 
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图 2-21 参数 图 输出 


对 比 mcga 包 和 genalg 包 ，mcga 包 适合 计算 大 范围 取 值 空间 的 最 优 解 ， 而 用 genalg 包 对 于 大 范围 取 值 空间 的 计算 表现 就 不 太 好 了 。 从 另 一 个 方面 讲 ，genalg 包 提供 了 可 视 化 工具 ， 可 以 让 我 们 直观 地 


看 到 遗传 算法 的 收敛 过 程 ， 对 于 算法 的 理解 和 调 优 是 非常 有 帮助 的 。 


在 掌握 了 遗传 算法 后 ， 我 们 就 可 以 快 度 地 处 理 一 些 优化 的 问题 了 


， 在 《R 的 极 客 理想 一 一 量化 投资 篇 》 中 ， 我 会 介绍 金融 回 测 系统 的 参数 寻 优 方案 。 让 我 们 远离 穷 举 法， 珍惜 CPU 的 每 一 秒 时 间 。 


本 节 参 考 了 文章 : Wiki 遗 传 算法 (http://zh.wikipedia.org/zh/ 遗 传 算法 ) 。 
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第 4 章 面向 对 象 编程 


第 3 章 ”R 内 核 编程 


二 部 分 深入 R 语 言 程序 开发 


本 章 主要 介绍 了 R 语 言 内 核 相 关 的 编程 ， 通 过 pryr 包 了 解 R 语 言 底 
读者 学 习 R 语 言 的 底层 知识 。 


层 的 特性 ， 了 解 R 语 言 环境 空间 的 定义 及 函数 环境 空间 的 使 用 ， 掌 握 R 语 言 文件 系统 的 管理 ， 以 及 R 语 言 3.1 版 本 新 特性 的 解读 ， 从 而 帮助 


3.1 “手动 R 内 核 的 高 级 工具 包 pryr 
问题 


怎么 了 解 R 的 内 部 运行 原理 ? 


J Peyr a 


promise 


make_function 


typename 
(5 partial 


pryr 


气动 R 内 核 的 高 级 工具 包 


http://blog.fens.me/r-pryr/ 


随 着 对 R 语 言 的 使 用 越 来 越 深 入 ， 我 们 需要 更 多 地 对 R 语 言 的 底层 进行 了 解 ， 比 如 面向 对 象 数 据 类 型 S3、S4、RC 以 及 函数 的 调用 机 制 等 。pryr 包 就 是 可 以 帮助 我 们 了 解 R 语 言 运行 机 制 的 工具 。 利 用 Pryr 
包 ， 我 们 可 以 更 容易 地 接触 R 语 言 的 核心 。 


3.1.1 pryr 介 绍 


pryr 包 是 一 个 深层 的 了 解 R 语 言 运 行 机 制 的 工具 ， 可 以 帮助 我 们 更 加 贴近 R 语 言 的 核心 。 为 了 能 开发 出 更 高 级 的 R 语 言 应 用 ， 我 们 需要 更 深入 地 懂 R。pryr 包 的 API 主 要 包括 内 音 
工具 、 辅 助 编程 函数 、 代 码 简化 工具 等 几 个 方面 的 功能 函数 ， 下 面 一 一 列 出 。 


实现 工具 、 面 向 对 象 检查 


内 部 实现 工具 : 


- promise 对 象 : uneval () 、is_promise () 

“ 查询 环境 变量 : where () . ors () 、parenv () 

“ 查看 闭 包 函 数 变量 : unenclose () 

“ 函数 调用 关系 : call tree. () 

- 查看 对 象 底层 对 应 的 C 语 言 类 型 : address () ~ refs () 、typename () 


“ 跟踪 对 象 是 否 被 修改 : track copy () 


面向 对 象 检查 工具 : 
: 判断 属于 哪 种 类 型 对 象 : otype () 


: 判断 属于 哪 种 类 型 函数 : ftype O 


助 编程 函数 : 


- 通过 参数 创建 函数 : make function () . f O 
“ 变量 表达 式 替换 : substitute q () . subs () 


- 批量 修改 对 象 : modify lang () 


- 快速 创建 list 对 象 : dots () . named dots () 
“ 建 匿名 函数 调用 : partial () 


“ 找 符合 条 件 函 数 : find funs () 


代码 简化 工具 : 
“ 创建 延迟 或 直接 绑 定 : %d<-%、%<a-% 
“ 创建 常量 绑 定 : %<c-% 


- 重新 绑 定 : rebind、<<- 


3.1.2 pryr 安 装 


本 节 使 用 的 系统 环境 是 : 


: Linux: Ubuntu Server 12.04.2 LTS 64bit 
- R: 3.1.1 x86. 64-pc-linux-gnu. (64-bit) 


注 _pryr 同 时 支持 Windows 7 环境 和 Linux 环 境 。 


安装 pryr 包 时 ， 可 以 直接 通过 CRAN 下 载 ， 也 可 以 通过 Github 来 安装 。 直 接 用 CRAN 下 载 安装 pryr 包 。 


aR + 启动 R 程 序 
> install.packages (pryr) # 安装 pryr 
> library (pryr) 


。 通 过 github 安 装 pryr 包 ，。 


d 


从 Github 安 装 pryr 包 需要 devtools 包 配合 ，devtools 的 详细 安装 说 明和 使 用 ， 请 参考 5.2 


~R + 启动 R 程 序 

> library (devtools) 4 加 载 devtools 

> install github ("pryr") # 通过 devtools 工 具 安 装 pryr 
> library (pryr) 


3.1.3 ”pryr 使 用 


接 下 来 ， 我 们 将 看 到 pryr 包 中 各 种 函数 的 使 用 。 


1. 创 建 匿 名 函数 f () 


通过 使 用 () 函数 ， 可 以 实现 创建 匿名 函数 并 在 单行 完成 函数 定义 、 调 用 、 运 算 的 操作 。 


»f(xty # 创建 一 个 匿名 函数 

function (x, y) 

x+y 

»f(x-*y (1, 10 # 创建 一 个 匿名 函数 ， 并 赋值 计算 

[1] 11 

> f(x, y-2, x+y) # 创建 一 个 匿名 函数 ， 指 定 参 数 x 和 参数 Y 的 默认 值 为 2 
function (x, y - 2) 

x+y 

2»f(x y-2, xty) U) # 创建 一 个 匿名 函数 ， 指 定 参数 x 和 参数 Y 的 默认 值 为 2， 并 赋值 计算 
[1] 3 

> f((y«- rmif (1) ; x * y) (3 # 创建 一 个 多 行 运算 的 匿名 函数 ， 并 赋值 计算 
[1] 3.7483 


2. 通 过 参数 创建 函数 make function () 


通过 给 make_function () 函数 传递 不 同 的 参数 ， 可 以 实现 动态 地 创建 一 个 函数 ， 而 不 需要 像 原 来 一 样 的 unction () 赋值 的 语法 ， 这 样 做 的 好 处 是 在 运行 时 动态 生成 函数 ， 并 和 环境 绑 定 ， 同 时 减少 
静态 代码 量 。 


查看 make_function () 函数 的 定义 ，make function () 函数 有 3 个 参数 。 


make function (args, body, env = parent.frame () ) 


nt 


中 参数 args 用 于 生成 函数 的 参数 部 分 ，list 类 型 ; body 用 于 生成 函数 的 表达 式 部 分 ， 语 法 表达 式 ，call 类 型 ;env 用 于 生成 函数 的 系统 环境 部 分 ，environment 类 型 ， 默 认 是 当前 环境 空间 的 父 环境 空间 。 


> f «- function (x) x *3 # 创建 标准 的 函数 
ek 

function (x) x +3 

> f (12) # 运行 函数 

[1] 15 

> g <- make function (alist (x = ) , quote (x + 3) ) # 通过 参数 创建 函数 
>g 

function (x) 

x+3 

> g (12) # 运行 函数 

[1] 15 


3. 创 建 匿名 函数 调用 partial () 


使 用 partial () 函数 ， 可 以 减少 参数 定义 的 过 程 ， 方 便 匿 名 函数 的 调用 ， 具 体 应 用 代码 如 下 。 


> compactl «- function (x) Filter (Negate (is.null) , x) + 定义 一 个 普通 的 函数 

> compacti 

function (x) Filter (Negate (is.null) , x) 

> compact2 <- partial (Filter, Negate (is.null) ) # 通过 partial 定 义 的 匿名 函数 
> compact2 


function (http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) 
Filter (Negate (is.null) , http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 


我 们 看 到 上 面 的 两 个 函数 定义 ， 一 个 是 标准 的 函数 定义 ， 另 一 个 是 用 partial () 函数 定义 的 匿名 函数 。 


再 看 另 一 例 : 输出 runif () 均匀 分 布 的 结果 。 


fl <- function () {runif (rpois (1, 5) ) } E 标准 函数 实现 
£1 () 

1] 0.09654228 0.93089395 0.85530142 0.33021067 0.16728877 0.79099825 
£l) 

1] 0.6166580 0.2100876 0.3125176 

f 

f 

] 

£ 

] 


2 «- partial (runif, n = rpois (1, 5)) 4 通过 Partial 的 匿名 函数 调用 
2 


i) 

0.25955143 0.12858459 0.04994997 0.11505708 0.10509429 
2 () 

0.9710866 0.1469317 


> 
> 
[ 
> 
[ 
> 
> 
[1 
> 
[ 


1 


4. 变 量 表 达 式 替换 substitute q () , subs () 


使 用 substitute_q () 函数 ， 可 以 对 表达 式 调用 ， 直 接 进行 参数 替换 。 


> x<- quote (a + b) # 定义 一 个 表达 式 调用 

> class (x) 

[1] "call" 

> substitute (x, list (a- 1, b-2)) # 对 x 调用 参数 替换 ， 无 效 
x 

> substitute (a^b, list (a = 1, b -2)) # 对 直接 变量 参数 蔡 换 
T ^ 

> substitute q (x, list (a = 1, b-2)) + 对 x 调用 参数 替换 
l4 

> eval (substitute q (x, list (a- 1, b -2))) # 执行 参数 调用 
[1] 3 


使 用 subs () 函数 ， 可 以 直接 对 变量 表达 式 蔡 换 


»a«-1 

-»b«-2 

> substitute (a + b) # 对 变量 表达 式 替换 ， 无 效 
a 

> 

1 


subs (a + b) # 对 变量 表达 式 赫 换 
$42 


5. 面 向 对 象 类 型 判断 otype () , ftype () 


要 判断 对 象 类 型 ，base 包 默认 提供 的 几 个 函数 实在 不 好 用 。 通 过 pryr 包 的 otype () 函数 可 以 很 容易 地 分 辨 出 33 类 型 、S4 类 型 、RC 类 型 的 对 象 ， 比 起 内 置 的 类 型 检查 要 高 效 得 多 。 


> otype (1: 10) + 基本 类 型 
1] "primitive" 
> otype (c ('a', 'd') ) 
1] "primitive" 
» otype (list (c ('a') , data.frame () ) ) 
1] "primitive" 
» otype (data.frame () ) # S3 类 型 
1] "S3" 
»x«1 * 自 定义 的 S3 类 型 
> attr (x, 'class') «-'foo' 
» is.object (x) 
1] TRUE 
> otype (x) 
1] "S3" 
» setClass ("Person", slots-list (name-"character", age-"numeric") ) 4d S4 类 型 
> alice<-new ("Person", name-"Alice", age-40) 
> isS4 (alice) 
1] TRUE 
» otype (alice) 
1] "S4" 
> Account«-setRefClass ("Account") # RC 类 型 
> a<-Account$new () 
> class (a) 
1] "Account" 
attr (, "package") 
1] ".GlobalEnv" 
» is.object (a) 
1] TRUE 
> isS4 (a) 
1] TRUE 
» otype (a) 
1] "RC" 


通过 ftype () 函数 可 以 很 容易 地 分 辨 出 function、primitive、S3、S4、internal 类 型 的 函数 ， 同 样 比 起 内 置 的 函数 类 型 检查 要 高 效 得 多 。 


> ftype int") # 标准 函数 

1] "function" 

> ftype (sum) # primitive 函 数 
1] "primitive" "generic" 

» ftype (writeLines) f internal 函 数 


1] "internal" 
» ftype (unlist) 
1] "internal" "generic" 


> ftype (t.data.frame) # S3 函 数 
1] "s3^ "method" 

> ftype (t.test) 

1] "s3" "generic" 

> setGeneric ("union") * SABE 


1] "union" 

» setMethod ("union", c (x-"data.frame", y-"data.frame") , function (x, y) (unique (rbind 
(x, y)» 

"union" 

» ftype (union) 

1] "s4" "generic" 

» Account«-setRefClass ("Account", * RC 函数 
fields-list (balance-"numeric") , 
methods-list ( 

withdraw-function (x) (balance««-balance-x], 
deposit-function (x) (balance««-balance*x]) ) 
> a«-Account$new (balance-100) 

» a$deposit (100) 

» ftype (a$deposit) 

[1] "ro" "method" 


[ei 


十 
4 
m 
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6. 查 看 对 象 底层 的 C 语 言 类 型 address () , refs () , typename () 


回 


我 们 可 以 通过 address () 、refs () 、typename () 来 查看 R 对 象 对 应 的 底层 C 语 言 实现 的 类 型 。 其 中 typename () 返回 C 语 言 类 型 名 ，address () 返回 内 存 地 址 ，refs () 返回 指针 数字 。 查 看 变 


量 的 C 语 言 类 型 ， 代 码 如 下 。 


> x«- 1:10 # 定义 一 个 变量 x 


» typename (x) # 打印 C 语 言 类 型 名 


1] "INTSXP" 

» refs (x) * 返回 指针 

TI d 

> address (x) # 打印 内 存 地址 

1] "0x365f560" 

> z <- list (1:10) # 定义 一 个 list 对 象 
> typename (z) # 打印 C 语 言 类 型 名 
1] "VECSXP" 

> delayedAssign ("a", 1 + 2) # 延迟 赋值 

> typename (a) # 打印 C 语 言 类 型 名 

1] "PROMSXP" 

>a # 打印 a 变 量 

1] 3 

» typename (a) 

1] "PROMSXP" 

> b«-3 # 定义 变量 D， 与 a 变 量 对 比 
> typename (b) 

1] "REALSXP" 


7. 查 看 对 象 是 否 被 修改 track_copy () 


使 用 track_copy () 函数 可 以 跟踪 对 象 ， 并 检查 对 象 是 否 被 修改 过 ， 通 过 内 存 地 址 进行 判断 。 


> a«-1:3;a t 定 浆 一 个 变 重 

[1] 41 .2-8 

> address (a) # 查看 变量 的 内 存 地址 

[1] "0x2ad77f0" 

> track a «- track copy (a) # 跟踪 变量 

> track a () # 检查 变更 是 否 被 修改 ， 没 有 修改 
» a[3] «- 3L # 给 变量 赋值 

> address (a) + 查看 变量 的 内 存 地 址 ， 没 有 变化 
[1] "Ox2ad77f0" 

> track a () # 检查 变量 是 否 被 修改 ， 没 有 修改 
> a[3]«-3 # 再 次 给 变量 赋值 

> address (a) # 查看 变量 的 内 存 地 址 ， 内 存 地 址 改变 
[1] "0x37f8580" 

> track a () # 检查 变量 是 否 被 修改 ， 已 被 修改 
a copied 


8. 查 看 闭 包 函数 变量 unenclose () 


使 用 unenclose () 给 闭 包 环境 的 变量 赋值 。 


> power <- function (exp) { # 定义 一 个 谋 套 函数 PoweT 

十 function (x) x ^ exp 

Tod 

> square <- power (2) # 调用 闭 包 函 数 

> cube <- power (3) 

> square * square, exp XE A Xo udis i0 6. 


function (x) x ^ exp 
«environment:  0x4055f28» 


» unenclose (square) 4 查看 square 函 数 ，exp 变 量 显 示 赋 值 后 的 结果 
function (x) 

x^2 

» square (3) 4 执行 square 函 数 

[1] 9 


9. 批 量 修改 对 象 modify lang () 


这 是 一 个 神奇 的 函数 ， 可 以 方便 地 蔡 换 list 对 象 、 表 达 式 、 函 数 中 的 变量 定义 。 接 下 来 ， 我 们 尝试 蔡 换 list 对 象 中 定义 的 变量 a 为 变量 b。 


> examples «- list ( # 定义 list 对 象 及 内 部 数据 
+ quote (a <- 5) , 

* alist (a = 1, c-a), 

* function (a = 1) a * 10, 

* expression (a « 1, a, f(a), f£(a-a)) 
十 ) 

> examples # 查看 对 象 数 据 

[[1]] 

a«-5 

LE211 

[[2]] $a 

[1] 1 

LE211$c 

a 

[[3]] 

function (a = 1) 

a * 10 

[[4]] 

expression (a <- 1, a, f(a), f(a=a)) 

> atob <- function (x) { + 定义 转换 函数 a_to_b， 


十 if (is.name (x) && identical (x, quote (a) ) ) return (quote (b) ) 
+ x 
n 


) 
> modify lang (examples, a to b) # 批量 修改 对 象 ， 将 examples 对 象 中 所 有 的 变量 a 替 换 成 变量 D 
1] 


[[3]] 

function (a = 1) 

b * 10 

[[4]] 

expression (b <- 1, b, f(b), f(a=b)) 


10. 快 速 创 建 list 对 象 dots () , named dots () 


使 用 dots () 函数 ， 我 们 可 以 快速 创建 ist 对 象 ， 通 过 参数 设置 list 的 数据 的 名 字 和 值 。 


>y<-2 + 初始 化 一 个 变量 

2 dots (x 1, y, z=) # 创建 1ist 对 象 

x 

[1] 1 

[[2]] 

Y 

$z 

> class (dots (x = 1, y, z - )) # 查看 对 象 类 型 
[1] "list" 

> str (dots (x-1, y, z=)) # 查看 对 象 的 内 部 结果 
List of 3 

$x: num 1 

$ : symbol y 

$ z: symbol 


使 用 named dots () 函数 ， 同 样 可 以 快速 创建 ist 对 象 ， 通 过 参数 设置 list 的 数据 的 名 字 和 值 。 与 dots () 函数 的 不 同 点 在 了 


FF ， 参 数 变量 就 是 list 的 数据 的 名 字 ， 如 变量 y 在 没有 赋值 情况 下 ， 也 被 用 作 Ilist 


数据 的 名 字 ， 并 可 以 通过 $y 来 得 到 值 。 


> named dots (x = 1, y, z =) 4 创建 1ist 对 象 
$x 

[1] 1 

$y 

Y 

$z 

> class (named dots (x = 1, y, z 9) t 查看 对 象 类 型 
[1] "list" 

> str (named dots (x = 1, y, z =)) # 查看 对 象 的 内 部 结果 
List of 3 

$x: num1 

$ y: symbol y 

$ z: symbol 


11 .查找 符 合 条 件 函 数 fun_calls () 


的 命令 查找 base 包 中 所 有 的 函数 ， 找 到 匹配 match.fun 字 符 串 的 函数 名 。 


回 


使 用 un_calls () 函数 ， 可 以 通过 过 滤 条 件 快速 找到 函数 。 下 


> find funs ("package: base", fun calls, "match.fun", fixed = TRUE) 
Using environment package: base 
[1] "apply" "eapply" "Find" "lapply 
[9] "Reduce" "sapply" "sweep" "tapply" 
> Map + 查看 Map 函 数 ， 检 查 是 否 包 括 match.fun 字 符 串 
function (f, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 
{ 


"mapply" "Negate" "outer" 


f <- match.fun (f) 
mapply (FUN = f, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/..., SIMPLIFY = FALSE) 


Xbytecode:  0x21688e0» 
«environment: namespace: base» 


查找 stats 包 中 所 有 函数 的 参数 ， 找 到 精确 匹配 FUN 字 符 串 的 函数 名 。 


> find funs ("package: stats", fun args, "^FUN$") 
Using environment package: stats 


[1] "addmargins" "aggregate.data.frame" "aggregate.ts" 

[4] "ave" "dendrapply" 

> ave *oXÉWavedsi RA, Kr*EAAÁICAA GS FONTARS 

function (x, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/..., FUN = mean) 


if (missing (http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ) 
x[] «- FUN (x) 
else ( 
g <- interaction (http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 
split (x, g) «- lapply (split (x, g) , FUN) 
} 


x 


} 
<bytecode: 0x2acba70> 
<environment: namespace: stats? 


12. 查 询 环境 变量 where () , rls () , parenv () 


使 用 where () 函数 ， 可 以 定位 对 象 在 R 环 境 中 的 位 置 ， 有 点 像 Linux 的 命令 whereis。 


> X <- 工 # 定义 一 个 变量 x 

> where ("x") # 查找 x 变量 的 环境 空间 
«environment: R GlobalEnv> 

> where ("t.test") # 查询 七 .test 函数 的 位 置 


«environment: package: stats? 

attr (, "name") 

[1] "package: stats" 

attr (, "path") 

[1] "/usr/lib/R/library/stats" 

= t.test 

function (x, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 
UseMethod ("t.test") 

Xbytecode: 0xlae9bc8> 

«environment: namespace: stats» 


» where ("mean") 4 查询 mean 函 数 的 位 置 
«environment: base» 
» where ("where") # 查询 where 函 数 的 位 置 


<environment: package: pryr> 

attr (, "name") 

[1] "package: pryr" 

attr (, "path") 

[1] "/home/conan/R/x86 64-pc-linux-gnu-library/3.0/pryr" 


使 用 rls () 函数 ， 可 以 显示 出 当前 环境 的 所 有 变量 ， 包 括 当前 环境 变 


" 
H 
dp 
E 
E 
Xt 
" 
H} 
E 
E 
xt 
出 | 


(the empty environment) 、 命 名 空间 环境 变量 。 


# 打印 当前 环境 的 变量 


"Account" "alice" "a to b" 
"compacti" "compact2" "examples" 
DE "£2" "g" 

"my long variable" "plot2" "union" 


# 打印 所 有 环境 的 变量 


"Account" 
[3] "alice" "a to b" 
[5] "b" ". C Account" 
[7] "compacti" "compact2" 
[9] ". C Person" "examples" 
11] "f" 一 "gj" 
13] "f2" "g" 
15] ". global " "myGeneric" 
17] "my long variable" "plot2" 
19] ".Random.seed" ".requireCachedGenerics" 
21] ". T myGeneric: .GlobalEnv" ". T union: base" 
23] "union" 


使 用 parenv () 函数 ， 可 以 找到 函数 调用 的 上 一 级 环境 ， 从 而 可 以 追溯 到 函数 的 根 。 


> adder <- function (x) function (y function (z) x +y+z # 定义 一 个 3 层 嵌 套 函 数 
> add2 «- adder (2 # 调用 第 一 层 函 数 

> add2 # 查看 函数 

function (y function (z) x+y+z 

<environment: 0x323c000> 

> add3<-add2 (3) # 调用 第 二 层 函 数 

> add3 

function (z) x*yc*z 

«environment:  0x3203558» 

> parenv (add3) # 查看 函数 调用 的 上 一 级 环境 
«environment: 0x323c000> 


> parenv (add2) 
<environment: R GlobalEnv> 


13. 打 印 调用 关系 call tree () , ast () 


使 用 call_tree () 函数 ， 可 以 打印 出 表达 式 的 调用 关系 。 


> call tree (quote (f (x, 1, g 0, h(10)))) # 谋 套 函数 语句 调用 
| 

NU E 

Nx 

Ne í 

Nc X 


ye h 
Nz OQ) 
Xe “E 
T Mr EE (quote (if (TRUE) 3 else 4)) # 条 件 语句 调用 
= 0 
Nc EE 
\- TRUE 
XAec-3 
\- 4 
> call tree (expression (1, 2, 3)) t 表达 式 语句 调用 
Ne i 
v2 
No 3 


使 用 ast () 函数 ， 可 以 直接 打印 语句 的 调用 关系 。 


»ast(f(x 1, g), h(iO))) + KERRATA 
V 
Ne E 
\- `x 
Ve 1 
Ac 
A 
Xo. 
\= “h 
v0 
Ne ur 
x asi (if (TRUE) 3 else 4) E 条 件 语句 
= A 
Nc EXE 
\- TRUE 
y= 3 
\- 4 
s ast (function (a = 1, b -2) {a + b}) # 函数 定义 
= R 
\- “function 
VOD 
\a=1 
Nb-22 
N00 
Nen 
No 9 
Ne ^ue 
Von 
= = 
N- 
»ast(£O Q0 Q2) * 函数 调用 
Y= Q 
Nen a) 
VOCE 


14.promisexjZ&uneval () , is promise () 


promise 对 象 是 R 语 言 中 延迟 加 载 机 制 的 一 部 分 ， 包 含 三 个 部 分 : 值 、 表 达 式 和 环境 。 当 函数 被 调用 时 参数 进行 匹配 ， 然 后 每 个 形式 参数 会 绑 定 到 一 个 promise 上 。 表 达 式 有 形式 参数 和 存储 在 promise 
里 的 函数 的 指针 。 


简单 来 说， 延迟 加 载 调用 过 程 就 是 ， 先 把 函数 指针 存储 在 promise 对 象 里 ， 并 不 马上 调用 ; 当 实 际 调用 发 生 时 ， 从 promise 对 象 里 找到 函数 指针 ， 进 行 函数 的 调用 。 


>x <- 10 # 定义 变量 并 赋值 

> is promise (x) # 检查 是 否 promise 模 式 

[1] FALSE 

> (function (x) is promise (x) ) (x = 10) # 匿名 函数 调用 ， 检 查 是 否 promise 模 式 
[1] TRUE 


使 用 uneval () 函数 ， 可 以 在 延迟 赋值 的 过 程 中 打印 函数 调用 方法 ， 而 不 执行 赋值 函数 调用 。 


> f <- function (x) ( # 定义 一 个 函数 
+ uneval (x) 

+} 

>f(a+b) # 打印 函数 调用 
atb 

> class (f (a+b) ) 

[1] "call" 

»f(1-424) # 打印 函数 调用 
144 

> delayedAssign ("x", 1 + 4) # 延迟 赋值 

> uneval (x) # 不 执行 函数 调用 ， 只 打印 函数 调用 
144 

>x E 执行 函数 调用 ， 并 赋值 

[1] 5 

> delayedAssign ("x", { # 延迟 赋值 

* for (i in 1: 3) 

* cat ("yippee! Mn") 

* 10 

+» 

>x # 执行 函数 调用 ， 并 赋值 
yippee! 

yippee! 

yippee! 

[1] 10 


15. 数 据 绑 定 %<a-%, 96«c-96, 96«d-96, rebind, <<- 


使 用 特殊 的 函数 ， 可 以 创建 自 定 义 的 运算 符 ， 通 过 运算 符 绑 定 数据 和 函数 调用 。 


直接 绑 定 : 


> x $«a-$ runif (1) 
>x 


1] 0.06793592 


1] 0.8217227 


>a<-1 # 对 已 知 变量 a 重新 赋值 

> rebind ("a", 2) 

> rebind ("ccc", 2) # 对 未 知 变量 ccc 重 新 赋值 ， 出 错 
Error: Can't find ccc 


> a<<-2 # 用 <<- 对 已 知 变量 a 重新 赋值 


> rm (ccc) # 删除 变量 ccc 


Error: object 'ccc' not found 

> ccc<<-2 # 用 <<- 对 未 知 变量 ccc 重 新 赋值 
> oca 

[1] 2 


通过 对 pryr 全 面 介绍 ， 我 们 了 解 这 个 包 的 强大 ， 对 于 R 的 运行 原理 和 数据 结构 的 理解 非常 有 帮助 ， 这 是 深入 R 内 核 之 前 我 们 必修 的 一 课 。 


3.2 ” 揭 开 R 语 言 中 环境 空间 的 神秘 面纱 


问题 


开 R 环 境 空 间 的 神秘 面纱 


http://blog.fens.me/r-environments/ 


对 于 大 部 分 的 R 使 用 者 来 说 ， 环 境 空间 都 是 比较 陌生 的 。 虽 然 我 们 不 了 解 它 的 运行 原理 ， 但 也 不 影响 我 们 使 用 R 语 言 。 环 境 空间 是 R 语 言 中 关于 计算 机 方面 的 底层 设计 ， 主 要 用 于 R 语 言 的 环境 加 载 器 。 通 
过 环境 空间 ， 封 装 了 加 载 器 的 运行 过 程 ， 让 使 用 者 在 不 知道 底层 细节 的 情况 下 ， 可 以 任意 加 载 使 用 到 的 第 三 方 R 语 言 程序 包 。 本 节 将 揭 开 R 语 言 中 环境 空间 的 神秘 面纱 。 


32.1 ”R 语 言 的 环境 空间 


在 R 语 言 中 ， 不 管 是 变量 、 对 象 或 者 函数 ， 都 存在 于 R 的 环境 空间 中 ，R 程 序 在 运行 时 变量 、 函 数 都 有 自己 的 运行 时 空间 。R 语 言 的 环境 (environment) 是 由 内 核定 义 的 一 个 数据 结构 ， 由 一 系列 、 有 


次 关系 的 框架 (frame) 组 成 ， 每 个 环境 对 应 一 个 框架 ， 


环境 空间 有 一 些 特征 ， 比 如 每 个 环境 空间 要 有 唯一 的 名 字 ; 环境 空间 是 引 


来 区 别 不 同 的 运行 时 空间 (scope) 。 


间 的 变量 等 。 
本 节 的 系统 环境 是 : 
: Linux: Ubuntu Server 12.04.2 LTS 64bit 


- R: 3.1.1 x86. 64-pc-linux-gnu. (64-bit) 


为 了 方便 我 们 检查 环境 空间 的 层次 关系 ， 引 入 pryr 包 作为 辅助 工 


， 关 于 pryr 包 的 详细 介绍 ， 请 参考 3.1 节 。 


类 型 ， 非 赋值 类 型 ;环境 空间 都 有 父 环境 空间 ， 空 环境 空间 是 最 顶 


层 


层 的 环境 空间 ， 没 有 父 空间 ; 子 环境 空间 会 继承 父 环境 空 


> library (pryr) # 加 载 pryr 包 


1. 创 建 一 个 环境 


通过 new.env () 函数 可 以 创建 一 个 新 的 环境 。 查 看 new.env () 函数 的 定义 。 


new.env (hash = TRUE, parent = parent.frame () , size = 291) 


参数 列表 : 
* hash 上 默认 值 是 TRUE ， 使 用 Hash table 的 结构 。 
“ parent 指 定 要 创建 环境 的 父 环 境 。 
“size， 初 始 化 的 环境 空间 大 小 。 


运行 函数 new.env () ， 创 建 一 个 新 环境 。 


> el «- new.env () # 创建 环境 el 
> el # 输出 el 
«environment: 0x3d7eef0> 

> class (el) t 查看 el 类 型 


[1] "environment" 
» otype (el) 
[1] "primitive" 


* Otype 查 看 el 类 型 ， 属于 基本 类 型 


接 下 来 ， 我 们 在 e1 环 境 中 定义 一 个 变量 。 


> el$a <- 10 # 定义 变量 a 

> el$a # 输出 变量 a 

[1] 10 

> 1s () * 列 出 当前 环境 中 的 变量 
[1] "el" 

> 1s (el) + 列 出 el 环境 中 的 变量 
[1] "a" 


这 时 ， 我 们 看 到 两 个 环境 空间 : 当前 环境 空间 和 e1 环 境 空间 。e1 作 为 一 个 变量 在 当前 的 环境 中 被 定义 ， 变 量 a 在 e1 环 境 中 被 定义 。 


2. 环 境 空间 的 层次 结构 


R 语 言 的 环境 空间 是 一 种 有 层次 关系 的 结构 ， 每 个 环境 都 有 上 一 层 环境 ， 直 到 最 顶层 的 空 环境 。R 语 言 中 有 5 种 环境 的 定义 ， 即 全 


“ 全 局 环境 ， 即 用 户 环境 ， 是 用 户 程序 运行 的 环境 空间 。 


“ 内 部 环境 ， 构 造 出 来 的 环境 ， 可 以 是 通过 new.env () 函数 显示 创建 的 环境 空间 ， 也 可 以 是 匿名 的 环境 空间 。 


“ 父 环 境 ， 即 上 一 层 环境 ， 环 境 空间 的 上 一 层 。 


“ 空 环 境 ， 即 顶层 环境 ， 没 有 父 环境 空间 。 


“ 包 环 境 ， 包 封装 的 环境 空间 。 


局 环境 、 内 部 环境 、 父 环境 、 


空 环境 和 包 环 境 。 


> environment () 
«environment: R GlobalEnv» 


# 当前 环境 


> el «- new.env () # 内 部 环境 
> el 

«environment:  0x3e28948» 

» parent.env (el) # 父 环 境 
«environment: R GlobalEnv> 

> emptyenv () 7 # 空 环境 
«environment: R EmptyEnv» 

» baseenv () T # 包 环 境 


<environment: base> 


可 以 用 search () 函数 查看 当前 环境 中 加 载 的 R 包 。 


> search () # 查看 环境 空间 
[1] ".GlobalEnv" "package: pryr" 
[4] "package: graphics" "package: grDevices 
[7] "package: datasets" "package: methods" 
[10] "package: base" 
» .GlobalEnv 
«environment: R GlobalEnv» 
» parent.frame () 
«environment: R GlobalEnv» 


# 当前 的 环境 空间 


"package: stats" 
package: utils" 
"Autoloads" 


查看 父 环境 空间 。 


> parent.env (el) # el 环境 的 父 环境 空间 


«environment: R GlobalEnv» 


» parent.env (environment () ) # 当前 环境 的 父 环境 空间 
«environment: package: pryr> 

attr (, "name") 

[1] "package: pryr" 

attr (, "path") 

[1] "/home/conan/R/x86 64-pc-linux-gnu-library/3.0/pryr" 


> parent.env (baseenv () ) # base 包 环境 的 父 环境 空间 

«environment: R EmptyEnv> 

> parent.env (emptyenv () ) # 空 环境 的 父 环境 空间 ， 因 没有 父 环境 ， 所 以 出 现 错误 
Error in parent.env (emptyenv () ) : the empty environment has no parent 


既然 环境 空间 是 有 层次 关系 的 ， 那 么 我 们 打印 这 个 层次 结构 ， 从 自 定义 的 e1 环 境 到 最 上 层 的 空 环境 。 


> parent.call«-function (e) { # 递归 打印 父 环境 空间 
+ print (e) 

+ if (is.environment (e) & ! identical (emptyenv () , e) ) ( 
十 parent.call (parent.env (e) ) 
+ cx 

+} 

> parent.call (e1) # 运行 函数 
«environment: 0x366bf18> 
«environment: R GlobalEnv» 
«environment: package: pryr> 

attr (, "name") 

"package: pryr" 

attr (, "path") 

1] "/home/conan/R/x86 64-pc-linux-gnu-library/3.0/pryr" 
«environment: package: stats? 
attr (, "name") 

1] "package: stats" 

attr (, "path") 

1] "/usr/lib/R/library/stats" 
«environment: package: graphics» 
attr (, "name") 

1] "package: graphics" 

attr (, "path") 

1] "/usr/lib/R/library/graphics" 
«environment: package: grDevices> 
attr (, "name") 

1] "package: grDevices" 

attr (, "path") 

1] "/usr/lib/R/library/grDevices" 
«environment: package: utils> 
attr (, "name") 

1] "package: utils" 

attr (, "path") 

1] "/usr/lib/R/library/utils" 
«environment: package: datasets» 
attr (, "name") 

1] "package: datasets" 

attr (, "path") 

1] "/usr/lib/R/library/datasets" 
«environment: package: methods» 
attr (, "name") 

1] "package: methods" 

attr (, "path") 
"/usr/lib/R/library/methods" 
«environment:  Ox20cb5d0» 

attr (, "name") 

1] "Autoloads" 

«environment: base» 

«environment: R EmptyEnv» 


m 


[e 


通过 递归 查找 父 环境 空间 ， 我 们 看 到 整个 环境 空间 的 层次 结构 ， 如 图 3-1 所 示 。 


通过 图 3-1 中 的 环境 空间 层次 结构 图 ， 我 们 还 可 以 发 现 R 包 的 加 载 顺 序 。 最 先 加 载 的 是 base 包 ， 然 后 通过 base: : Autoloads () 函数 分 别 加 载 6 个 基础 包 ， 上 层 的 pryr 包 则 是 笔者 手动 加 载 的 ， 最 后 以 
R_GlobalEnv 环 境 作为 当前 运行 环境 空间 ， 内 部 环境 空间 是 R_GlobalEnv 环 境 的 下 层 环境 空间 。 


<environment: package:pryr? 


Xenvironment: package:grDevices> Xenvironment: package:graphics> <environment: package: stats> 


<environment: package:utils> <environment: package:datasets> <environment: package:methods> 


<environment: R EmptyEnv> <environment: base? Xenvironment: 0x20cb5d0> 


图 3-1 环境 空间 层次 结构 图 


3.2.2 “环境 空间 的 特征 


上 面 提 到 环境 空间 有 一 些 特征 ， 下 面 我 们 分 别 介绍 。 


1 每 个 环境 空间 中 的 对 象 名 字 要 唯一 


在 当前 环境 空间 中 定义 变量 名 x， 并 对 x 进 行 操作 。 


> x«-10; x + 定义 变量 x 

[1] 10 

> address (x) + 查看 x 地 址 

[1] "0x2874068" 

> x€d1;x # 对 x 改变 赋值 

[1] 11 

> address (x) # 查看 x 地 址 
[1] "0x28744c8" 


这 样 我 们 可 以 看 到 ，x 变 量 在 每 次 赋值 的 时 候 ， 内 存 地 址 都 会 发 生 改 变 ， 但 是 x 的 名 字 还 是 x。 下 面 在 不 同 的 环境 空间 中 ， 再 定义 一 个 变量 x。 


> el<-new.env () + 创建 环境 空间 el 
> el$x<-20 # 在 el 中 定义 变量 x 
> x; el$x + 输出 x 

n] 12 

[1] 20 


在 不 同 的 环境 空间 中 ， 可 以 有 同名 的 变量 出 现 ， 而 同一 个 环境 空间 中 ， 不 能 有 同名 的 变量 。 
2. 环 境 空间 变量 的 赋值 


如 果 把 e1 环 境 空间 变量 赋值 给 另 一 个 变量 f， 再 修改 其 环境 内 部 变量 ， 会 是 什么 结果 呢 ? 


>£<- el # 把 el 赋值 给 

> el$a «- 1111 * 修改 el 中 a 变量 的 值 

> f$a + 查看 £ 环 境 空间 的 a 值 

[1] 1111 

> identical (f, el) # 比较 f 环 境 和 el 环境 ， 是 相等 的 
[1] TRUE 

> el # 查看 el 和 f 的 环境 地 址 ， 是 完全 相同 的 
«environment: 0x3e28948> 

>i 


«environment: 0x3e28948> 


从 上 面 的 运行 结果 可 以 看 出 ， 环 境 空间 的 赋值 是 一 种 引入 的 传递 ， 并 不 会 新 创建 一 个 环境 空间 变量 。 


3. 定 义 更 上 层 的 环境 空间 


空 环境 是 最 顶层 的 环境 空间 ， 然 后 是 base 包 的 环境 空间 ， 我 们 可 以 烷 试 创建 一 个 靠近 顶层 的 环境 空间 ， 让 父 环境 空间 是 base 包 的 环境 空间 。 


> e2 <- new.env (parent = baseenv () ) ; e2 # 创建 e2 环 境 ， 以 base 为 父 环境 
«environment: 0x37cab18> 
> parent.call (e2) + 查看 e2 环 境 的 父 环境 列表 


«environment: 0x37cab18> 
«environment: base» 
«environment: R EmptyEnv» 


这 样 e2 环 境 空间 就 位 于 环境 空间 中 的 第 三 层 了 。 


4. 子 环境 空间 会 继承 父 环境 空间 的 变量 


在 当前 环境 中 定义 一 个 变量 x， 在 子 环境 e1 中 对 x 重新 赋值 。 


> x<-1: 5 # 在 当前 环境 定义 变量 x 

> el <- new.env ( # 新 建 环境 空间 el 

> el$x<-1 + el 环境 空间 中 定义 变量 x 

> el$fun<-function (y) { # 在 el 环境 空间 中 定义 函数 ， 并 对 父 环境 空间 的 x 变量 重新 赋值 
* print ('el: : fun') 

+ xy 

Tj 

» el$fun (50) + 运行 el 环境 空间 中 的 函数 ， 将 x 赋 值 为 50 
[1] "el: : fun" 

>x # 当前 环境 x 变量 被 修改 

[1] 5i 

> el$x # el 环境 x 变量 没有 变化 

| 


如 果 想 修改 父 环境 空间 的 变量 值 ， 我 们 就 需要 用 到 < <- 赋 值 符号 了 ， 很 多 朋友 一 直 疑 惑 的 符号 <<- 和 符号 <- 的 区 别 ， 也 就 在 于 此 。 


3.2.3 “环境 空间 的 访问 


R 语 言 提供 了 一 些 基础 函数 ， 可 以 帮助 我 们 理解 和 使 用 环境 空间 。 


“ new.env 创 建 一 个 环境 空间 。 
“is.environment 判 断 是 否 是 环境 空间 类 型 。 
“ environment 查 看 函数 的 环境 空间 定义 。 

* environmentName 查 看 环境 空间 名 字 。 

“ env.profile 查 看 环境 空间 属性 值 。 

“ls 查看 环境 空间 中 的 对 象 。 


“ get 取出 指定 环境 空间 中 的 对 象 。 


“ rm 删除 环境 空间 中 的 对 象 。 
“ assign 给 环境 空间 中 的 变量 赋值 。 
“ exists 查 看 指定 环境 空间 中 的 对 象 是 否 存 在 。 


接 下 来 ， 我 们 进行 环境 空间 的 访问 操作 。 


» el«-new.env () + 新 建 一 个 环境 空间 
> is.environment (el) + 判断 el 是 否 是 环境 空间 类 型 


1] TRUE 
» environment () # 查看 当前 环境 空间 
«environment: R GlobalEnv» 
» environment (1s) # 查看 函数 的 环境 空间 
Xenvironment: namespace: base» 
» environmentName (baseenv () ) # 查看 环境 空间 的 名 字 
1] "base" 


» environmentName (environment () ) 

1] "R GlobalEnv" 

> environmentName (e1) # 查看 el 环境 空间 的 名 字 
1po€" 

> attr (el, "name") «-"e1" + 设置 el 的 名 字 

> environmentName (el) 

i] "el" 

> env.profile (el) # 查看 el 环境 空间 的 属性 值 
$size 

1] 29 

$nchains 

1] 1 

$counts 
[(1100001000000000000000000000000 


环境 空间 中 的 对 象 操作 。 

> rm (list-ls () ) # 清空 当前 环境 空间 定义 的 所 有 对 象 
> el<-new.env () # 定义 环境 空间 和 3 个 变量 x 
> x<-1: 5; y<-2: 10 

> el$x<-10 

> 1s () # 查看 当前 环境 中 的 变量 

1] "el" "x" "y" 

> 1s (el) # 查看 el 环境 空间 中 的 变量 

1] "x" 

> get ("x") # 取 当 前 环境 空间 的 x 值 
1112345 

» get ("x", envir-el) # 取 el 环 境 空间 的 x 值 

1] 10 


# 在 el 环境 空间 中 取 y 值 ， 这 个 y 值 是 从 当前 环境 空间 中 继承 的 
> get ("y", envir-el) 

1 2345678 910 

E 禁止 环境 空间 的 继承 ， 在 el 环境 空间 中 取 值 ， 出 错 

> get ("y", envir=el, inherits=FALSE) 


Error in get ("y", envir = el, inherits = FALSE) : object 'y' not found 
> assign ('x', 77) ; x + 给 x 重新 赋值 

1] 77 

» assign ('x', 99, envir-el) ; el$x # 给 el 环境 空间 的 x 重新 赋值 

1] 99 


+ 在 没有 继承 的 情况 下 ， 给 el 空间 增加 y 变 量 

> assign ('y', 99, envir=el, inherits=FALSE) ; 

>y 

1 2345286728 910 

> el$y 

1] 99 

# 删除 el 环境 空间 的 变量 x 和 当前 环境 空间 的 y 

> rm (x, envir-el) 

> el$x 

NULL 

> 

1] 77 

+ 查看 当前 环境 空间 和 el 环境 空间 

> lIs 0 
1] "el" 

» ls (el) 
1] "y" 

# 查看 x 对 象 在 当前 环境 空间 是 否 存在 

> exists ('x') 

1] TRUE 

# 查看 x 对 象 在 el 环境 空间 是 否 存 在 

> exists ('x', envir-el) 

1] TRUE 

# 查看 x 对 象 ， 在 没有 继承 的 情况 下 ， 在 el 环境 空间 是 否 存 在 

> exists ('x', envir=el, inherits=FALSE) 

1] FALSE 


另外 ，pryr 包 的 where 函 数 可 以 直接 定位 对 象 的 环境 空间 。 


# 查看 mean 函 数 定义 的 环境 空间 

> where (mean) 

Error: is.character (name) is not TRUE 
» where ("mean") 

«environment: base» 

* 查看 where 函 数 定义 的 环境 空间 

> where ("where") 

«environment: package: pryr> 

attr (, "name") 

[1] "package: pryr" 

attr (, "path") 

[1] "/home/conan/R/x86 64-pc-linux-gnu-library/3.0/pryr" 
# 查看 x 变量 定义 的 环境 空间 

> where ("x") 

«environment: R GlobalEnv> 

# 查看 y 变 量 定义 的 环境 空间 ， 由 于 y 变 量 定义 在 el 中 ，el 是 当前 空间 的 子 空间 ， 所 以 访问 不 到 y 变 量 
> where ("y") 

Error: Can't find y 

> el$y 

[1] 99 

# 在 el 空间 查看 y 变 量 

> where ("y", el) 

«environment:  0x2545db0» 


本 节 介 绍 了 R 语 言 中 环境 空间 的 定义 、 结 构 和 一 些 简单 应 用 ， 可 以 帮助 大 家 更 进一步 地 了 解 R 语 言 的 底 
不 仅 能 结构 清晰 而 且 会 运行 高 效 。 


3.3 ”解密 Ri 语言 函数 的 环境 空间 
问题 


怎么 应 用 R 语 言 中 的 函数 环境 空间 ? 


层 结构 。 环 境 : 


H 


日 


司 的 使 


对 于 我 们 开发 R 包 来 说 至 关 重 要 ， 


一 旦 用 好 环境 空间 ， 那 么 你 所 开发 的 R 包 


本 节 接 上 一 节 继 续 介绍 R 语 言 中 函数 的 环境 空间 。 有 语言 的 函数 环境 空间 具有 动态 性 ， 可 以 让 我 们 用 更 少 的 代码 构建 出 更 复杂 的 应 用 。 


3.3.1 _R 语 言 的 函数 环境 空间 
在 R 语 言 中 ， 变 量 、 对 象 、 函 数 都 存在 于 环境 空间 中 ， 而 函数 又 可 以 有 自己 的 环境 空间 ， 我 们 可 以 在 函数 内 再 定义 变量 、 对 象 和 函数 ， 循 环 往复 就 形成 了 我 们 现在 用 的 R 语 言 环境 系统 。 
一 般 情况 下 ， 我 们 可 以 通过 new.env () 去 创建 一 个 环境 空间 ， 但 更 多 的 时 候 ， 我 们 使 用 的 是 函数 环境 空间 。 函 数 环境 空间 ， 包 括 以 下 四 方面 的 内 容 。 
“ 封闭 环境 ， 每 个 函数 都 有 且 只 有 一 个 封闭 环境 空间 ， 指 向 函数 定义 的 环境 空间 。 
“ 绑 定 环境 ， 给 函数 指定 一 个 名 字 ， 绑 定 到 函数 变量 ， 如 funl<-function () {1}。 
“ 运行 环境 ， 当 函数 运行 时 ， 在 内 存 中 动态 产生 的 环境 空间 ， 运 行 结束 后 ， 会 自动 销毁 。 
: 调用 环境 ， 是 指 在 哪个 环境 中 进行 的 方法 调用 ， 如 fun1<-function () (fun2 O }， 函 数 fun2 在 函数 fun1 中 被 调用 。 
本 节 的 系统 环境 是 : 
+ Windows 7 64bit 


-R:O3.1.1 x86. 64-w64-mingw32/x64. (64-bit) 


3.3.2 ”封闭 环境 


封闭 环境 比较 好 理解 ， 是 对 函数 空间 的 一 个 静态 定义 ， 在 函数 定义 时 指向 所 在 的 环境 空间 ， 通 过 environment () 函数 来 查看 封闭 环境 。 我 们 在 当前 的 环境 空间 定义 一 个 函数 伸 ， 查 看 f1 函 数 的 封闭 环 
境 为 R_GlobalEnv。 


»yc-1 

> f1 <- function (x) x + y 
» environment (f1) 
«environment: R GlobalEnv» 


THREXL— PESERÉ2, MRAN R, frEf2PRGRBUEITIMMAJJR GlobalEnv, 


» f2 «- function (x) ( 

+ f1(0 47 

T3 

» environment (f2) 
«environment: R GlobalEnv» 


所 以 ， 封 闭环 境 是 在 定义 的 时 候 设置 的 ， 与 具体 运行 时 环境 没有 关系 。 


3.3.3 ” 绑 定 环境 


绑 定 环境 就 是 把 函数 的 定义 和 调用 通过 函数 变量 连 起 来 。 比 如 ， 我 们 新 建 一 个 环境 空间 e， 在 e 的 环境 空间 中 定义 一 个 函数 g， 就 相当 于 把 一 个 函数 绑 定 到 9 变量 ， 通 过 找到 e 环 境 空间 中 的 9 变量 ， 就 可 以 
调用 这 个 函数 。 
> e «- new.env () # 新 建 一 个 环境 空间 
> e$g «- function () 4 绑 定 一 个 函数 到 e$g 
> e$g # 查看 函数 g 的 定义 
function () 1 
> e$g () # 运行 函数 g 
[1] 1 
在 环境 空间 e 中 再 定义 一 个 识 套 函数 egf。 
> e$f «- function () ( # 绑 定 一 个 函数 到 eS$f 
+ function () 1 
+} 
> e$f # 查看 函数 工 的 定义 
function () ( 
function () 1 
> e$f () # 调用 函数 下， 返回 多 套 的 匿名 函数 定义 
function () 
«environment:  0x000000000dbc0a28» 
1 E 0 0 # 调用 函数 E， 和 谋 套 匿名 函数 ， 得 到 结果 
GJL 
查看 函数 9 和 f 的 封闭 环境 . 
E 函数 g 和 工 的 封闭 环境 
> environment (e$g) 
«environment: R GlobalEnv» 
> environment (e$f) 
«environment: R GlobalEnv> 
* 工 内 部 的 匿名 函数 的 封闭 环境 
> environment (e$f () ) 
«environment:  0x000000000d90b0b0» 
# 匿名 函数 的 父 函 数 的 封闭 环境 
> parent.env (environment (e$f () ) ) 
«environment: R GlobalEnv» 
我 们 看 到 e$g 和 e$f 两 个 函数 定义 的 封闭 环境 ， 都 是 当前 环境 R_GlobalEnv。 而 e$f () 的 匿名 函数 的 封闭 环境 ， 是 当前 环境 的 子 环境 ， 也 就 是 egf 函 数 的 环境 空间 。 
3.34 ”运行 环境 
运行 环境 是 函数 被 调用 时 产生 的 内 存 环 境 。 运 行 环境 是 临时 的 ， 当 函数 运行 完成 后 ， 运 行 环境 会 被 自动 销毁 。 在 运行 环境 中 定义 的 变量 、 对 象 和 函数 ， 也 是 动态 创建 的 ， 随 着 内 存 释 放 而 销毁 。 
定义 一 个 函数 9， 在 函数 g 中 ， 有 人 临时 变量 a 和 参数 x。 
> g <- function (x) 1 d 定义 函数 g 
+ if (! exists ("a", inherits = FALSE) ) ( 
+ a<-1 
+ } 
+ a<-a+x 
+ a 
+} 
> g (10) EEC 
[1] 11 
> g (10) 
[1] 11 
调用 2 次 函数 9， 运 行 结果 都 是 11。 我 们 可 以 看 出 ， 变 量 a 在 g 函 数 中 为 临时 变量 ， 没 有 进行 持久 化 ， 每 次 调用 函数 g 时 ，a 都 是 新 的 值 。 增 加 一 些 输出 信息 ， 我 们 再 来 看 看 ， 这 个 函数 的 运行 情况 。 
»g«- function (x) ( 
十 message ("Runtime function") # 增加 注释 
十 Print (environment () ) # 打印 运行 时 环境 
十 if (! exists ("a", inherits = FALSE) ) { 
* ac-i 
* } 
+ a<-a+x 
+ a 
+} 
+ 调用 函数 gq 
> g (10) 
Runtime function 
«environment: 0x000000000e447380> 
[1] 11 
> g (10) 
Runtime function 
«environment: 0x000000000d2fa218> 
[1] 11 
我 们 还 是 调用 2 次 g 函 数 ， 看 到 print (environment () ) 的 输出 ， 有 2 个 不 同 的 环境 地 址 0x000000000e447380 和 0x000000000d2fa218。 说 明 函 数 的 运行 时 环境 ， 是 内 存 临 时 分 配 的 。 
3.3.5 ”调用 环境 
调用 环境 是 指 函数 是 在 哪个 环境 中 被 调用 的 。 匿 名 函数 通常 是 在 定义 的 封闭 环境 中 被 调用 。 下 面 我 们 定义 一 个 谋 套 的 函数 h， 包 括 一 个 匿名 函数 。 
>h <- function () ( # 函数 h 
十 x «- 
* function () ( # 匿名 函数 
十 x 
本 
+} 
Sxl a + 调用 函数 h， 把 h 函 数 内 部 的 匿名 函数 赋值 给 1 
» x «- 10 + 在 当前 环境 定义 变量 x 
> rt) + 调用 函数 r1 
[ 


ri () 函数 运行 后 的 结果 为 5， 说 明 r1 () 函数 获得 的 是 
变量 赋值 ， 相 当 于 给 父 环境 空间 中 的 x 变 量 赋值 。 


匿名 函数 所 在 的 封闭 环境 的 x 值 ， 而 不 是 变量 所 在 的 当前 环境 的 x 值 。 我 们 把 代码 稍 做 修改 ， 在 函数 h 中 ， 定 义 2 个 x 变 量 。 上 


<<- 符 号 给 第 二 个 x 


h <- function () 
x 0 
x «€ 5 
function () 


> { 
+ a 

4 

+ { 


1<- h) + 调用 函数 h 
1) # 调用 函数 zl1 () 


# 当前 空间 的 变量 x 


一 V 一 VV ++ 十 


ri () 函数 运行 后 的 结果 为 10， 说 明 r1 () 函数 获得 的 是 匿名 函数 所 在 的 封闭 环境 的 x 值 10， 而 不 是 通过 < < -符号 赋值 的 父 环境 中 的 x 的 值 。 


3.3.6 ”完整 的 环境 操作 


接 下 来 ， 把 函数 环境 空间 的 操作 放 到 一 起 ， 做 一 个 完整 环境 的 说 明 ， 如 图 3-2 所 示 。 


environment: OQxW00000000e0db178 


environment: 0x000000000e0e8cf0 


environment: R GlobalEnt 


c R 


environment: 0:x000000000e0db220 


environment: [base 一 一 
| 


environment: R EuptyEnv 


图 3-2 的 解释 如 下 : 


(1) 小 实心 圆 ， 表 示 函 数 封闭 ， 始 终 指向 函数 定义 的 环境 空间 。 


(2) 左 侧 大 长 方形 ， 表 示 已 加 载 的 包 环境 空间 ， 包 括 R_GlobalEnv、base 和 R_EmptyEnv 等 。 
(3) 右 侧 大 长 方形 ， 表 示 已 定义 的 函数 环境 空间 ， 包 括 environment: 0x000000000e0db220 和 environment: 0x000000000e0e8cf0。 
(4) 右 侧 大 长 方形 内 的 小 长 方形 ， 表 示 命名 函数 ， 包 括 fun1 和 fun2。 


(5) 左上 不 在 大 长 方形 内 的 小 长 方形 ， 表 示 已 定义 的 匿名 函数 ， 包 括 function。 


(6) 在 大 长 方形 内 的 小 正方 形 ， 表 示 在 环境 空间 中 定义 的 变量 ， 包 括 x、fx 和 f2。 
(7) 不 在 大 长 方形 内 的 小 正方 形 ， 表 示 在 内 存 中 的 变量 值 ， 包 括 5、2、1。 
(8) 细 实 线 ， 表 示 变 量 的 赋值 。 


(9) 细 虚 线 ， 表 示 指 向 封闭 环境 空间 。 


(10) 粗 实 线 ， 表 示 函 数 调用 过 程 。 


(11) 程序 运行 时 ， 产 生 了 函数 环境 空间 的 内 存 地 址 ， 包 括 0x000000000e0db220、0x000000000e0e8cfo 和 0x000000000e0db178。 


3-2 中 的 结构 ， 用 R 代 码 描述 ， 如 下 所 示 。 


D 


> x«-5 + 在 当前 环境 定义 变量 x 

> funi«-function () { # 在 当前 环境 定义 funl 

* print ("funl") # 打印 fun1 环 境 空间 

+ print (environment () ) 

+ o xc-l # 在 fun1 函 数 环境 中 ， 定 义 变量 x 

+ function () 

十 print ("funX") # 打印 匿名 环境 空间 

十 print (environment () ) 

* x+15 E 从 一 级 父 环境 空间 中 ， 找 到 变量 X 
+o} 

+} 

> fun2<-function () { # 在 当前 环境 定义 fun2 

* print ("fun2") # 打印 fun2 环 境 空间 

+ print (environment () ) 

+ x<-2 + 在 Eun2 函 数 环境 中 ， 定 义 变量 X 

+ funl () # 调 用 函数 funl 

+} 

> f2<-fun2 () # 在 当前 环境 空间 中 ， 调 用 函数 fun2， 绑 定 到 f2 
[1] "fun2" 

«environment:  0x000000000e0db220» 

[1] "funi" 

«environment:  0x000000000e0e8cf0» 

> fx«-f2 () # 在 当前 环境 空间 中 ， 调 用 匿名 函数 ， 并 绑 定 到 fx 
[1] "funx" 

«environment: 0x000000000e0db178> 

> fx # 输出 fx 的 结果 

[1] 16 


最 后 ， 通 过 完整 的 例子 ， 我 们 清楚 了 R 语 言 环境 空间 的 基本 结构 和 调用 关系 。 接 下 来 ， 我 们 就 可 以 利用 环境 空间 的 特性 来 做 一 些 实际 的 开发 任务 了 。 


注 本 节 中 对 函数 环境 空间 的 定义 ,参考 了 Hadley Wickham 的 《Advanced R} , M] 


[由 本 书 中 文 版 也 将 由 机 械 工 业 出 版 社 华章 分 社 出 版 。 
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34 用 R 进 行文 件 系统 管理 


问题 


有 怎么 操作 文件 ? 


Qa ui 


用 R 进 行文 件 系 统管 理 


http://blog.fens.me/r-file-folder/ 


El 


3. 


件 系统 来 保存 数据 ， 不 必 关 心 数 


[zi 


了 语言 作为 脚本 语言 ， 有 一 套 文 件 系统 管理 的 功能 函数 ， 也 可 以 实现 如 Python 一 样 的 系统 管理 功能 。 本 节 将 详细 介绍 R 语 言 的 文件 系统 管理 。 试 试 有 什么 不 一 样 吧 ? 


4.1 文件 系统 介绍 


计算 机 的 文件 系统 是 一 种 存储 和 组 织 计算 机 数据 的 方法 ， 它 使 得 对 其 访问 和 查找 变 得 容易 ， 文 件 系统 使 
居 实 际 保存 在 硬盘 (或 者 光盘 ) 的 地 址 为 多 少 的 数据 块 上 ， 只 需 


文件 和 树 形 目 录 的 抽象 逻辑 概念 代替 了 硬盘 和 光盘 等 物理 设备 使 


记 住 这 个 文件 的 所 


,硬盘 上 的 存储 空间 管理 (分配 和 释放 ) 功能 由 文件 系统 自动 完成 ， 


3. 


户 只 需要 记 住 数据 被 写 入 到 了 哪个 文件 中 。 


属 目录 和 文件 名 。 在 写 入 新 数据 之 前 ， 


R 语 言 和 其 他 编程 语言 一 样 ， 都 有 对 文件 系统 的 操作 、 包 括 文件 操作 和 目录 操作 ， 函 数 APl 都 定义 在 base 包 中 。 我 们 接 下 来 就 介绍 用 R 进 行文 件 系统 管理 。 


42 ”目录 操作 


本 节 的 系统 环境 是 : 
: Linux: Ubuntu Server 12.04.2 LTS 64bit 


- R: 3.1.1 x86. 64-pc-linux-gnu. (64-bit) 


数据 块 的 概念 ， 


使 


文 


不 必 关 心 硬盘 上 的 那个 块 地 址 有 没有 被 使 


1. 查 看 目录 

随意 进入 一 个 目录 ， 启 动 R 程 序 ， 通 过 R 语 言 函 数 查看 当前 目录 下 的 子 目录 。 
~ + 启动 R 程 序 

> getwd () # 当前 的 目录 

[1] "/home/conan/R/fs" 

> list.dirs () # 查看 当前 目录 的 子 目录 

n). v. /tmp" 

查看 当前 目录 的 子 目 录 和 文件 。 


» dir () 
[1] "readme.txt" "tmp" 
» dir (path-"/home/conan/R") 


# 查看 当前 目录 的 子 目录 和 文件 
# 查看 指定 目录 的 子 目 录 和 文件 


[2] "Astat" "caTools" 

[3] "chinaWeather" "DemoRJava" 

[5] "env" "FastRWeb" 

[7] "font" "fs" 

[9] "github" "lineprof" 
[11] "pryr" "readme.txt" 
[13] "RMySQL" "RServe" 

[15] "rstudio-server-0.97.551-amd64.deb" "websockets" 

[17] "x86 64-pc-linux-gnu-library" 

» dir (path-"/home/conan/R", pattern-'^R') # 只 列 出 以 字母 R 开 头 的 子 目录 或 文件 
[1] "RMySQL" "RServe" 


> dir (path-"/home/conan/R", all.files-TRUE) 
+ 列 出 目录 下 所 有 的 目录 和 文件 ， 包 括 隐藏 文件 ， 如 .A.txt 


n]. 
[3] ".A.txt" "A.txt" 
[5] "caTools" "chinaWeather" 
[7] "DemoRJava" "env" 
[9] "FastRWeb" "font" 
[11] "fs" "github" 
[13] "lineprof" "pryr" 
[15] "readme.txt" "RMySQL" 
[17] "RServe" "rstudio-server-0.97.551-amd64.deb" 
[19] "websockets" "x86 64-pc-linux-gnu-library" 


"http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.." 


还 有 另 一 种 方式 ， 查 看 当前 目录 的 子 目录 和 文件 ， 同 dir () 函数 。 


> list.files () 
[1] "readme.txt" "tmp" 


> list.files (".", all.files-TRUE) 
pup o" "http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.." "readme.txt" "tmp" 
查看 完整 的 目录 信息 。 


+ 查看 当前 目录 权限 
> file.info (".") 
size isdir mode mtime ctime atime uid 
1000 1000 conan 
+ 查看 指定 目录 权限 
> file.info ("./tmp") 


size isdir mode 


conan 


mtime ctime 


1000 1000 conan conan 


gid uname grname 
. 4096 TRUE 775 2013-11-14 08: 40: 46 2013-11-14 08: 40: 46 2013-11-14 08: 41: 57 


atime uid gid uname grname 
./tmp 4096 TRUE 775 2013-11-14 14: 35: 56 2013-11-14 14: 35: 56 2013-11-14 14: 35: 


56 


2. 创 建 目录 


如 果 我 们 要 在 当前 目录 下 ， 新 建 一 个 目录 ， 可 以 用 下 面 的 代码 。 


> dir.create ("create") 
» list.dirs () 


nj." "./create" "./tmp" 


创建 一 个 3 级 子 目录 ./a1/b2/c3。 


> dir.create (path-"al/b2/c3") + 直接 创建 ， 出 错 
marning message: 

In dir.create (path = "al/b2/c3") 
cannot create dir 'al/b2/c3', 
> dir.create (path-"al/b2/c3", recursive = 
» list.dirs () 

nj." 


reason 'No such file or directory' 
TRUE) + 递归 创建 ， 成 功 
"./al/b2/c3" "./create" 


"./al" "./al/b2" 


"L/tmp" 


系统 命令 ， 查 看 目录 结构 。 


在 R 语 言 中 ， 也 可 以 直接 调 


» system ("tree") t 通过 系统 命令 查看 目录 结构 
| ar] = 2| c3! create | readme.txt — — tmp 
3. 检 查 目录 是 否 存在 


我 们 可 以 通过 file.exists () 函数 检查 目录 是 否 存 在 。 


ile.exists (".") 

TRUE 

ile.exists ("./al/b2") 
TRUE 

ile.exists ("./aa") 
FALSE 


1 


>E 
[1] 
>f 
[1] 
>Ë 
[1] 


1 


+ 目录 存在 


# 目录 不 存在 


4 .检查 目录 的 权限 


对 于 Linux 系 统 ， 每 个 目录 和 文件 都 是 权限 定义 。 


我 们 可 以 检查 目录 的 权限 。 


> df«-dir (full.names = TRUE) 
> file.access (df, 0) == # 检查 文件 或 目录 是 否 存 在 ，mode=0 
Jat ./create ./readme.txt ./tmp 
TRUE TRUE TRUE TRUE 
> file.access (df, 1) 一 E 检查 文件 或 目录 是 否 可 执行 ，mode=1， 目 录 为 可 以 执行 
./al  ./create  ./readme.txt ./tmp 
TRUE TRUE FALSE TRUE 
> file.access (df, 2) == # 检查 文件 或 目录 是 否 可 写 ，mode=2 
./al  ./create  ./readme.txt | ./tmp 
TRUE TRUE TRUE TRUE 
> file.access (df, 4) 一 # 检查 文件 或 目录 是 否 可 读 ，mode=4 
./al  ./create  ./readme.txt | ./tmp 
TRUE TRUE TRUE TRUE 
我 们 还 可 以 修改 目录 的 权限 。 
> Sys.chmod ("./create", mode = "0555", use umask = TRUE) # AARAM, MAMP RH 
> file.info ("./create") + 查看 目录 完整 信息 ，mode=555 
size isdir mode mtime ctime atime uid gid uname grname 


./create 4096 TRUE 555 2013-11-14 08: 36 


: 28 2013-11-14 09: 07: 05 2013-11-14 08: 36: 39 


1000 1000 conan conan 
> file.access (df, 2) == # Create 目录 不 可 以 写 
./al  ./create  ./readme.txt | ./tmp 
TRUE FALSE TRUE TRUE 
5. 对 目录 重 命 
我 们 可 以 通过 file.rename () 函数 对 目录 进行 重 命名 。 
> file.rename ("tmp"， "tmp2") # 对 tmp 目 录 重 命名 
[1] TRUE 
# 查看 目录 
» dir () 
[1] "al" "create" "readme.txt" "tmp2" 
6 .删除 目录 
我 们 可 以 通过 unlink () 函数 删除 一 个 目录 ， 如 果 目 录 中 包括 子 目录 或 文件 ， 需 要 递归 删除 。 
> unlink ("tmp2", recursive = TRUE) # 删除 tmp2 目 录 
> dir () # 查看 目录 
[1] "al" "create" "readme.txt" 
7. 其 他 功能 函数 


除了 一 些 基础 的 目录 操作 外 ，R 语 言 还 提供 了 一 些 辅助 功能 函数 ， 比 如 # 


拼接 目录 字符 串 。 


接 目录 字符 串 ， 获 取 最 底层 的 子 目 录 名 ， 转 换文 件 扩 | 


展 路 径 ， 标 准 化 路 径 转换 Windows 或 linux 的 路 径 分 隔 符 、 短 路 径 等 。 


> file.path ("pl", "p2", "p3") 
[1] "pl/p2/p3" 

> dir (file.path ("al", "b2") ) 
[1] "c3" 


* 


拼接 目录 字符 串 


Bx 


获 


取 最 底层 的 子 目 录 名 。 


> getwd () 

[1] "/home/conan/R/fs" 
> dirname ("/home/conan/R/fs/readme.txt") 
[1] "/home/conan/R/fs" 

> basename (getwd () ) 

[1] "fs" 

> 
[ 


1] "readme.txt" 


basename ("/home/conan/R/fs/readme.txt") 


# 当前 目录 


# 完整 的 目录 路 径 
# 最 底层 的 目录 名 
# 最 底层 的 文件 名 


转换 文件 扩展 路 径 。 


ath.expand ("-/foo") 


> p 
[1] "/home/conan/foo" 


# 转换 ~ 为 用 户 目录 


标准 化 路 径 ， 


用 来 转换 Windows 或 linux 的 路 径 分 隔 符 。 


> normalizePath (c (R.home () , tempdir () 
[1] "/usr/lib/R" "/tmp/RtmpqNy; PD" 
> normalizePath (c (R.home () , tempdir () 
[1] "C: \\Program Files NRNNR-3.0.1" 


F3 
)) 


# Linux 系 统 


4 Windows 系 统 


[2] "C: \\Users\\Administrator\\AppData\\Local\\Temp\\RtmpMtSnci" 


短路 径 ， 缩 减 路 径 的 显示 长 度 ， 只 在 Windows 中 运行 。 


» shortPathName (c (R.home () , tempdir () ) ) # Windows 4 
[1] "C: NNPROGRA-1NNRNNR-30-1. 1" 
[2] "C: NNUsers MADMINI-1NMAppData NNLocalN Temp NNRTMPMT- 1 " 


343 ”文件 操作 


R 语 言 不 仅 可 以 对 目录 操作 ， 还 可 以 对 文件 进行 操作 ， 有 丰富 的 API 支 持 。 
1. 查 看 文件 


我 们 可 以 通过 dir () 函数 查看 当前 目录 的 文件 。 


> dir () # 查看 当前 目录 的 文件 
[1] "create" "readme.txt" 
» file.exists ("readme.txt") # 检查 文件 是 否 存在 
[1] TRUE 
> file.exists ("readme.txt222") # 文件 不 存在 
[1] FALSE 
» file.info ("readme.txt") # 查看 文件 完整 信息 
size isdir mode mtime ctime atime uid gid uname grname 


readme.txt 7 FALSE 664 2013-11-14 08: 24: 50 2013-11-14 08: 24: 50 2013-11-14 08: 24: 50 
1000 1000 conan conan 

> file.access ("readme.txt", 0) E 查看 文件 访问 权限 ， 存 在 
readme.txt 

0 
» file.access ("readme.txt", 1) # 文件 权限 ， 不 可 执行 
readme.txt 

= 让 
> file.access ("readme.txt", 2) + 文件 权限 ， 可 写 
readme.txt 

0 
> file.access ("readme.txt", 4) # 文件 权限 ， 可 读 
readme.txt 

0 


> file.access ("readme.txt222") # 查看 一 个 不 存在 的 文件 访问 权限 ， 不 存在 
readme.txt222 
E 


判断 是 文件 还 是 目录 。 


ile test ("-d", "readme.txt") + 判断 是 否 是 目录 
FALSE 

ile test ("-d", "create") 

TRUE 

ile test ("-f", "readme.txt") + 判断 是 否 是 文件 
TRUE 

ile test ("-f", "create") 

FALSE 
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2. 创 建文 件 


我 们 可 以 通过 file.create () 函数 创建 一 个 文件 。 


> file.create ("A.txt") 4o€ik—^4xEX4ROA.txt 

[1] TRUE 

> cat ("file BWn", file = "B.txt") + 创建 一 个 有 内 容 的 文件 B.txt 
> dir () 

[1] "A.txt" "B.txt" "create" "readme.txt" 

» readLines ("A.txt") # 打印 A.txt 

character (0) 

> readLines ("B.txt") 4 dTÉpB.txt 

[1] "file B" 


把 文件 B.txt 的 内 容 ， 合 并 到 Atxt。 


> file.append ("A.txt", rep ("B.txt", 10) ) * 合并 文件 
[1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 
» readLines ("A.txt") # 查看 文件 内 容 
[1] "file B" "file B" "file B" "file B" "file B" "file B" "file B" "file B" "file B" 
"file B" 
把 文件 A.txt 复 制 到 文件 C.txt 
> file.copy ("A.txt", "C.txt") E 复制 文件 
[1] TRUE 
> readLines ("C.txt") # 查看 文件 内 容 
[1] "file B" "file B" "file B" "file B" "file B" "file B" "file B" "file B" "file B" 
"file B" 
3. 修 改 文件 权限 


我 们 可 以 通过 Sys.chmod () 函数 修改 文件 权限 。 


E 修改 文件 权限 ， 创 建 者 可 读 可 写 可 执行 ， 其 他 人 无 权限 

> Sys.chmod ("A.txt", mode = "0700", use umask = TRUE) 

> file.info ("A.txt") E 查看 文件 信息 
size isdir mode mtime ctime atime uid 
gid uname grname 

A.txt 70 FALSE 700 2013-11-14 12: 55: 18 2013-11-14 12: 57: 39 2013-11-14 12: 55: 26 
1000 1000 conan conan 


4 文件 重 命 


我 们 可 以 通过 file.rename () 函数 对 文件 重 命名 。 


> file.rename ("A.txt", "AA.txt") # 给 文件 A.txt 重 命名 为 AA.txt 
[1] TRUE 

> dir () 

[1] "AA.txt" "B.txt" "create" nSt” "readme.txt" 

5. 硬 连接 和 软 连接 


硬 连 接 ， 指 通过 索引 节点 来 进行 连接 。 在 Linux 的 文件 系统 中 ， 保 存在 磁盘 分 区 中 的 文件 不 管 是 什么 类 型 都 会 被 分 配 一 个 编号 ， 称 为 索引 节点 号 。 在 Linux 中 ， 多 个 文件 名 指向 同一 索引 节点 是 存在 的 。 


一 般 这 种 连接 就 是 硬 连 接 。 硬 连接 的 作用 是 允许 一 个 文件 拥有 多 个 有 效 路 径 名 ， 这 样 用 户 就 可 以 建立 硬 连 接 到 重要 文件 ， 以 防止 “ 误 删 ”的 功能 。 其 原因 如 上 所 述 ， 因 为 与 该 目录 对 应 的 索引 节点 有 一 个 以 
上 的 连接 。 只 删除 一 个 连接 并 不 影响 索引 节点 本 身 和 其 他 的 连接 ， 只 有 当 最 后 一 个 连接 被 删除 后 ， 文 件 的 数据 块 及 目录 的 连接 才 会 被 释放 。 也 就 是 说 ， 文 件 真 正 删除 的 条 件 是 与 之 相关 的 所 有 硬 连接 文件 均 
被 删除 。 


软 连接 ， 也 叫 符号 连接 。 软 链接 文件 有 类 似 于 Windows 的 快捷 方式 。 它 实际 上 是 一 个 特殊 的 文件 。 在 符号 连接 中 ， 文 件 实际 上 是 一 个 文本 文件 ， 其 中 包含 的 有 另 一 文件 的 位 置信 息 。 


注 “ 硬 连 接 和 软 连接 ， 只 在 Linux 系 统 中 使 用 。 


> file.link ("readme.txt", "hard link.txt") + 硬 连 接 
[1] TRUE = 

> file.symlink ("readme.txt", "soft_link.txt") t 软 连接 
[1] TRUE T 

> system ("ls -1") + 查看 文件 目录 
“EW 1 conan conan 70 Nov 14 12: 55 AA.txt 
-rw-rw-r-- 1 conan conan 7 Nov 14 12: 51 B.txt 


dr-xr-xr-x 2 conan conan 4096 Nov 14 08: 36 create 

-rw-rw-r-- l conan conan 70 Nov 14 12: 56 C.txt 

-rw-rw-r-- 2 conan conan 7 Nov 14 08: 24 hard link.txt 

-rw-rw-r-- 2 conan conan 7 Nov 14 08: 24 readme.txt 

lrwxrwxrwx 1 conan conan 10 Nov 14 13: 11 soft link.txt -> readme.txt 


文件 hard link.txt 是 文件 readme.txt 硬 连接 文件 ， 文 件 soft_link.txt 是 文件 readme.txt 软 连接 文件 。 


6 .删除 文件 


删除 文件 有 两 个 函数 可 以 使 用 ， 即 file.remove () 和 unlink () ， 其 中 unlink 函 数 使 用 同 删除 目录 操作 是 一 样 的 。 


> file.remove ("A.txt", "B.txt", "C.txt") + MRH 
[1] FALSE TRUE TRUE 

> unlink ("readme.txt") # 删除 文件 

> system ("ls -1") # 查看 目录 文件 
total 12 

—EIWXx-c---- 1 conan conan 70 Nov 14 12: 55 AA.txt 
dr-xr-xr-x 2 conan conan 4096 Nov 14 08: 36 create 
-rw-rw-r-- 1 conan conan 7 Nov 14 08: 24 hard link.txt 
lrwxrwxrwx 1 conan conan 10 Nov 14 13: 11 soft link.txt -> readme.txt 
> readLines ("hard link.txt") # 打印 硬 连接 文件 
[1] "file A" 


# 打印 软 连接 文件 ，soft 1ink.txt， 由 于 原文 件 被 删除 ， 有 错误 
> readLines ("soft link.txt") 


Error in file (con, "r") : cannot open the connection 
In addition: Warning message: 
In file (con, "r") 


cannot open file 'soft link.txt': No such file or directory 


3.4.4” 几 个 特殊 的 目录 


“ R.home () 查看 R 软 件 的 相关 目录 

“ .Library 查 看 R 核 心包 的 目录 

“ .Library.site 查 看 R 核 心包 的 目录 和 root 用 户 安装 包 目 录 
` .libPaths () 查看 R 所 有 包 的 存放 目录 

“system.file () 查看 指定 包 所 在 的 目录 


1.R.home () 查看 R 软 件 的 相关 目录 


> R.home () # 打印 R 软 件 安装 目录 
[1] "/usr/lib/R" 

» R.home (component-"bin") # 打印 R 软 件 bin 的 目录 

[1] "/usr/lib/R/bin" 

» R.home (component-"doc") # 打印 R 软 件 bin 的 目录 

[ 


1] "/usr/share/R/doc" 


通过 系统 命令 ， 找 到 R 文 件 的 位 置 。 


^ whereis R E 检查 系统 中 R 文 件 的 位 置 

R: /usr/bin/R /etc/R /usr/lib/R /usr/bin/X11/R /usr/local/lib/R /usr/share/R / 
usr/share/man/manl/R.1l.gz 

^ echo SR HOME # 打印 环境 变量 R_HOME 

/usr/lib/R zi 


通过 R.home () 函数 ， 我 们 可 以 很 容易 地 定位 R 软 件 的 目录 。 


2.R 软 件 的 包 目 录 

> .Library # 打印 核心 包 的 目录 

[1] "/usr/lib/R/library" 

> .Library.site # 打印 核心 包 的 目录 和 root 用 户 安装 包 目 录 


[1] "/usr/local/lib/R/site-library" "/usr/lib/R/site-library" 
[3] "/usr/lib/R/library" 

» .libPaths () # 打印 所 有 包 的 存放 目录 

[1] "/home/conan/R/x86 64-pc-linux-gnu-library/3.0" 

[2] "/usr/local/lib/R/site-library" 

[3] "/usr/lib/R/site-library" 

[4] "/usr/lib/R/library" 


3. 查 看 指定 包 所 在 的 目录 

> system.file () # base 包 的 存放 目录 

[1] "/usr/lib/R/library/base" 

> system.file (package = "pryr") * pryr 包 的 存放 目录 


[1] "/home/conan/R/x86 64-pc-linux-gnu-library/3.0/pryr" 


其 实 ， 用 R 语 言 操作 文件 系统 还 是 很 方便 的 。 但 对 于 函数 命名 确实 不 太 规范 ， 需 要 我 们 花 时间 记 忆 。 


3:5 


问题 


R 语 言 3.1.x 版 本 新 特性 


如 何 掌握 RR 语言 的 新 特性 ? 


R 语 言 3. .X 版 本 新 特性 


http://blog.fens.me/r-version-3-1/ 


RR 语言 在 不 断 地 发 展 和 进步 ， 从 3.0.0 版 本 开始 ，R 语 言 开始 了 具有 里 程 碑 式 的 发 展 ， 并 且 持 续 壮 大 和 发 展 。R 内 核 在 不 断 更 新 ， 越 来 越 多 的 纯 计算 机 技术 指标 在 增加 ， 向 着 企业 级 商用 语言 在 靠近 。 本 节 


， 有 17 项 新 特性 发 布 ， 并 解决 了 35 个 


将 介绍 R 的 最 新 版 本 3.1.x 的 新 特性 及 使 用 。 
E7H10 


3.5.1 R 语 言 3.1.x 版 本 介绍 
F4 月 10 日 发 布 ， 发 布 了 64 项 新 特性 ， 修 复 了 16 个 bug， 是 一 次 很 大 规模 的 升级 。 目 前 的 最 新 版 本 的 R 语 言 3.1.1 版 本 发 布 于 2014: 


R 语 言 3.1.0 版 本 于 2014 征 


3 个 维度 来 衡量 ， 即 X.Y.Z， 按 照 从 左 到 右 的 顺序 以 点 分 隔 ， 如 Ri 语言 的 3.1.1 版 本 。 
3 发布 建议 大 家 升级 ， 使 用 最 新 的 软件 ， 比 如 Java5、Java6、jJava7、Java8 每 次 升级 都 对 Java 性 能 及 特性 有 重大 的 提升 及 


bug。 
一 般 软件 产品 版 本 发 布 ， 都 
" X 代 表 最 大 的 版 本 号 ， 表 示 有 重大 的 更 新 或 者 里 程 碑 的 功能 点 发 布 ， 大 版 本 号 新 
向 前 不 兼容 ， 以 致 很 多 原来 开发 的 应 用 都 不 能 运行 了 ， 如 Python 2.7.x 和 Python 3.x 就 是 语法 不 兼容 的 ， 现 在 只 能 两 套 版 本 并 行 。 
会 影响 使 用 ， 可 以 想起 来 再 升级 ， 差 一 两 个 Y 的 版 本 没 


改进 。 当 然 ， 大 版 本 的 升级 ， 也 可 
“了 代表 中 版 本 号 ， 主 要 表现 在 功能 上 ， 每 一 次 Y 的 版 本 升级 ， 都 会 对 当前 版 本 补充 很 多 小 功能 ， 这 些小 功能 一 般 是 不 太 会 引起 大 家 的 注意 ， 也 不 


什么 关系 。 


EA 
理解 为 给 系统 打 补丁 ， 只 有 你 过 到 这 个 bug 才 需要 打 补 丁 ， 如 果 没 有 这 到 bug， 对 于 Z 的 版 本 ， 我 们 可 以 不 升级 ， 等 下 个 Y 版 本 发 布 再 统一 升级 。 
语言 能 构建 独立 的 应 用 服务 器 ， 如 果 R 语 言 能 方便 地 处 理 socket 和 http 协 议 ， 如 果 R 语 言 能 处 理 


“ZZ 代表 小 版 本 号 ， 主 要 表现 在 解决 bug 上 ， 每 个 X 和 Y 版 本 的 升级 都 可 能 会 引起 bug， 这 些 bug 需 要 及 时 修复 ， 所 以 Z 的 版 本 会 经 常 性 地 发 布 ， 有 时 候 是 一 两 个 月 也 可 能 三 五 天 。 我 们 可 以 把 Z 的 版 本 号 ， 


语言 能 支持 异步 ， 如 果 R 语 言 能 
中 大 放 异 彩 。 
到 3-3 所 示 。 


能 支持 并 发 ， 如 果 R 语 言 能 


R 语 言 的 快速 更 新 ， 其 实 代表 了 市 场 迫 切 的 声音 。 丸 
已 经 有 无 数 的 功能 需求 被 提交 到 了 R 的 核心 团 
从 R 语 言 版 本 平均 每 4 个 月 新 发 布 一 次 ， 就 能 看 出 大 家 都 在 努力 着 。 我 们 可 通过 官方 的 软件 镜像 下 载 R 语 言 最 新 版 本 软件 包 (http://cran.rstudio.com/) ， 并 查看 版 本 更 新 的 详细 描述 ， 如 


果 R 语 言 能 
队 。 我 也 希望 R 的 技术 小 组 能 早日 攻克 这 些 技术 难题 ， 让 R 在 企业 级 的 应 


大 数据 .…… 


€ 93 Q |D cran.rstudio.com 
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Mirrors 
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Contributed 


本 节 的 系统 环境 是 : 
* Windows 7 64bit 


“ R: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 


新 


The Comprehensive R Archive Network 


Download and Install R 


Precompiled binary distributions of the base system and contributed 
packages, Windows and Mac users most likely want one of these versions of R: 


下 载 R 安 装 包 


* Download R for Linux 


» Domload R for (Mac) OS X 


* Domload R for Windows 


R is part of many Linux distributions, you should check with your Linux 
package management System in addition to the link above. 


Source Code for all Platforms 


Nindows and Mac users most likely want to download the precompiled binaries 
listed in the upper box, not the source code. The sources have to be 
compiled before you can use them. If you do not know what this means, you 
probably do nct want to do it! 


* The latest rclcasc (2014-07-10, Sock it to Me) R-3.1.1. tar.gz, read 


性 [hats new |i the latest version. 


» Sources of R alpha and beta releases (daily snapshots, created only in 
time periods before a plarmed release). 


* Daily snapshots of current patched and development versions are 
available here. Please read about new features and bug fixes before 
filing corresponding feature requests or bug reports. 


» Source code of older versions of R is available here. 


* Contributed extension packages 


Qucstiens About R 


* If you have questions about R like how to download and install the 


3-3 有 软件 新 版 本 发 布 页 


下 面 我 就 全 面 解释 R 语 言 3.1.0 和 3.1.1 两 个 版 本 的 新 特性 ， 并 做 代码 的 描述 。 


3.5.2. R 语 言 3.1.0 新 特性 及 代码 描述 


R 语 言 3.1.0 版 本 的 别名 是 Spring Dance， 下 载 R3.1.0 版 本 后 ， 你 可 以 通过 version 来 查看 版 本 信息 。 


~ 有 + 启动 R 程 序 

> version # 查看 版 本 信息 
platform x86 64-w64-mingw32 
arch x86 64 

os mingw32 

system x86 64, mingw32 
status 

major 3 

minor 1.0 

year 2014 

month 04 

day 10 

svn rev 65387 

language R 


version.string R version 3.1.0 (2014-04-10) 
nickname Spring Dance 


R3.1.0 有 以 下 64 个 新 特性 。 


(1) type.convert () 函数 主要 用 在 read.table () 函数 中 ， 返 回 向 量 和 因子 类 型 ， 当 输入 为 double 型 时 会 丢失 精度 。 


> type.convert (c ('abc', 'bcd') ) 
[1] abc bcd 
Levels: abc bcd 


> type.convert (c (as.double (1.12121221111) , '1.121') ) 


[1] 1.121212 1.121000 


# 返回 因子 类 型 


# double 型 丢失 精度 


(2) 如 果 一 个 文件 包含 有 小 数位 的 数据 ， 通 过 read.table () 函数 读 取 时 ， 会 指定 为 numeric 类 型 。 


新 建 一 个 文件 num.csv 包 括 小 数 。 


1, 2, 1.11 
2.1, 3, 4.5 


用 read.table 读 取 文 件 ， 并 查看 列 的 类 型 。 


v 


numc-read.table (file-"num.csv", sep-", ") + 读 文件 
num 
V1v2 V3 
1.0 2 1.11 
2.1 3 4.50 
class (num) 
1] "data.frame" 
class (num$V1) * 查看 列 的 类 型 为 numeric 
1] "numeric" 


v 


ayay N 


(3) tools 包 用 Rdiff () 函数 的 参数 useDiff 为 FALSE 时 ， 与 POSIX 系 统 的 diff-b 命 令 类 似 。 


新 建文 件 num2.csv。 


3, 2, 1:11 
2.1, 3, 4.5 


Rdiff () 比较 两 个 文件 num.csv 和 num2.csv。 


> Rdiff ('num.csv', 'num2.csv', useDiff = FALSE) 
«1, 2,1.11 

»3,2,1.11 

[1] 1 


(4) 新 函数 anyNA () ， 结 果 与 any (isna (.) ) 一 致 ， 性 能 更 好 。 


> is.na (c (1, NA) ) 

[1] FALSE TRUE 

> any (is.na (c (1, NA) ) ) 
[1] TRUE 

> anyNA (c (1, NA) ) 

[1] TRUE 


(5) arraylnd () 和 which () 函数 增加 useNames 参 数 ， 用 于 列 名 的 匹配 。 我 在 测试 过 程 ， 不 太 理解 这 个 参数 的 意义 。 


> which 
function (x, arr.ind = FALSE, useNames = TRUE) 


(6) is.unsorted () 函数 支持 处 理 原始 数据 的 向 量 。 


> is.unsorted (1: 10) * 排序 的 向 量 

[1] FALSE 

» is.unsorted (sample (1: 10) ) # 无 序 的 向 量 
[1] TRUE 


(7) 用 于 处 理 table 的 as.data.frame () 函数 和 as.data.frame.table () 函数 ， 支 持 向 provideDimnames (sep, base) 函数 传 参数 。 我 在 测试 过 程 中 ， 也 不 理解 具体 是 什么 更 新 。 


(8) uniroot () 函数 增加 新 的 可 选 参 数 extendInt， 人 允许 自动 扩展 取 值 范围 ， 并 增加 返回 对 象 参数 init.it。 


> £1 <- function (x) (121 = x^2) / (x^241) *ORAELfl 
» f2 «- function (x) exp (-x) * (x - 12) # 函数 f2 
> try (uniroot (f1, c (0, 10) ) ) # Æ (0, 10) ERRELEA 


Error in uniroot (fl, c (0, 10) ) 

f () values at end points not of opposite sign 
> try (uniroot (£2, c (0, 2) )) # Æ (0, 2) 的 区 间 求 f2 函 数 的 根 
Error in unirocot (£2, c (0, 2)) : 

f () values at end points not of opposite sign 


» str (uniroot (fl, c (0, 10) , extendInt-"yes") ) # 通过 extendInt 参 数 扩大 取 值 搜索 范围 
List of 5 

$ root : num 11 

$ f.root num -3.63e-06 

$ iter int 12 

$ init.it : int 4 

$ estim.prec: num 6.1e-05 

> str (uniroot (f2, c (0, 2) , extendInt-"yes") ) # 通过 extendInt 参 数 扩大 取 值 搜索 范围 
List of 5 

$ root : num 12 

$ f.root : num 4.18e-11 

$ iter : int 23 

$ init.it  : int 9 


$ estim.prec: num 6.1e-05 


(9) switch (f, ) 函数 ， 当 参数 { 是 因子 类 型 时 ， 会 给 出 警告 提示 ， 需 要 转换 字符 串 参数 。 


> ff<-gl (3, 1, labels-LETTERS[3: 1]) 


> switch (ff[1], A = "I am A", B-"Bbhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/..", C=" is C") # -> "A" 
[1] "I am A" 
Warning message: 
In switch (ff[1], A = "I am A", B = "Bbhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/..", C =" is C") 
EXPR is a "factor", treated as integer. 
Consider using 'switch (as.character ( * ) , http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ' instead. 
> switch (as.character (ff[1]) , A = "I am A", B-"Bbhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/..", C-" is C") 
[1] " is C" 


E 


* 


(10) 解析 器 已 经 更 新 ， 使 用 更 少 的 内 存 。 


(11) 一 元 运算 符 “+-! ”对 属性 值 操作 时 ， 会 做 一 份 拷贝 计算 ， 但 names，dims 和 dimnames 是 例外 的 。 


> x<-1: 12; x + 创建 变量 x 

[1] 12 3 45 6 78 9101112 
> x5 # 拷贝 计算 ， 不 影响 原 变量 x 的 值 

[1] 6 7 8 910 11 12 13 14 15 16 17 
»!x 

[1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE 
> dim (x) «-c(3,4);x E 直接 修改 原 变量 x 的 值 

L1] D, 21 D, 31 D, 41 


[25] 2 


(12) colorRamp () 和 colorRampPalette () 支持 透明 色 ， 让 alpha 参 数 为 TRUE。 


> cols«-colorRampPalette (c (rgb (0, 0, 1, 1) , rgb (1, 0, 1, 0) ) , alpha = TRUE) # 取 色 的 函数 句柄 
> filled.contour (volcano, color.palette -cols, asp = 1) # 画图 ， 带 透明 色 火 山 图 片 ， 如 图 3-4 所 示 。 


1.0 
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0.6 
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0.0 
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H3-4 带 透 明 色 火山 图 


(13) grid.show.layout () 函数 和 grid.show.viewport () 函数 ， 都 增加 一 个 可 选 的 参数 vp.ex， 用 于 布局 缩放 。 


1 


.9 


> library (grid) # 加 载 gird 包 

> grid.show.layout # 查看 函数 定义 

function (1, newpage = TRUE, vp.ex = 0.8, bg = "light grey", 
cell.border = "blue", cell.fill = "light blue", cell.label = TRUE, 
label.col = "blue", unit.col = "red", vp = NULL) 


(14) 新 的 函数 find_ gs cmd () 在 tools 包 中 ， 用 来 定位 GhostScript 的 可 执行 文件 。 


(15) objectsize () 函数 增加 format () 方法 定义 ， 用 于 格式 显示 。 


> letters 
[1] "a" "p" "c" "g" "e" mg" "g" "h" "in "jn "k" "]" "m" "n" "o" "pn "g" "g" "on npn 
[21] "u" "v" "ut "g" "y" "z" 
» object.size (letters) # 查看 letters 对 象 大 小 
1496 bytes 
> format (object.size (letters) , units = "auto") # 格式 化 显示 
[1] "1.5 Kb" 


(16) 增加 新 字体 ArialMT， 用 于 pdf () 和 postscript () 设备 输出 。 


(17) R 软 件 的 NEWS 和 NEWS.2 文 件 ， 及 新 生成 的 文本 和 PDF 文件 ， 被 移 到 doc 目 录 存 储 。 


> dir ("C: /Program Files/R/R-3.1.0/doc") 4 查看 doc 目 录 ， 包 括 NENS 和 NEWS .2 文件 
[1] "AUTHORS" "CHANGES" "CHANGES . rds" "COPYING" 
[5] "COPYRIGHTS" "CRAN mirrors.csv" "FAQ" "html" 
[9] "KEYWORDS" "KEYWORDS . db" "manual" "NEWS" 

[13] "NEWS.0" "NEWS.1" "NEWS.2" "NEWS .pdf" 

[17] "NEWS.rds" "README.packages"  "README.Rterm" "RESOURCES" 

[21] "rw-FAQ" "THANKS" 


(18) combn (x) 函数 支持 参数 x 为 因子 类 型 ， 并 返回 因子 类 型 。 


> combn (letters[1: 4], 2) # 字符 串 类 型 
D, 1] [, 21 [, 31 L, 41 [, 51 EL, 61 

[1, ] "a" "a" "a" "p" "p" "o" 

[2; ] "p" "c" "d" "c" "d" "d" 

> combn (factor (letters[1: 4]) , 2) # 因子 类 型 
L1] L 22 bL, 31] b 41 DL, 51 E, 61 

[1, ] a a a b b c 


[2, ] b c d c d d 
Levels: abcd 


(19) 在 utils 包 增加 fileSsnapshot () 函数 和 changedFiles () 函数 ， 用 于 产生 目录 的 文件 快照 和 和 比较 目录 的 快照 文件 。 


> snapshot«-fileSnapshot () + 产生 快照 
> snapshot 
File snapshot: 

path = D: \workspace\R\basic\r311 
timestamp = 

file.info = TRUE 

md5sum = FALSE 

digest = NULL 

full.names = FALSE 

args - list () 

9 files recorded. 


> writeBin (3L: 4L, "a.txt") + 在 当 目 录 中 增加 一 个 文件 a .Ext 
> changedFiles (snapshot) # 比较 目录 快照 
Files added: 

a.txt 


(20) make.names () 可 以 处 理 不 合法 的 变量 命名 ， 当 unique 参 数 为 TRUE 时 ， 新 生成 的 变量 名 不 重复 。 


> make.names (c ("a b", "a.b", "a-b") ) # 处 理 不 正确 的 变量 名 
[1] "a.b" "a.b" "a.b" 

» make.names (c ("a b", "a.b", "a-b") , unique - TRUE) # 会 生成 3 个 不 同 的 变量 名 
[1] "a.b.1" "a.b" "a.b.2" 


(21) 增加 新 函数 cospi (x) . sinpi (x) 和 tanpi (x) ， 用 于 精确 计算 cos (pi*x) ， 被 lgamma () 和 bessell () 等 函数 底 


层 调 


> x<-1222222222222221 .323232 
> cospi (x) # 当 X 变 量 值 过 大 时 ， 解 决 cos (pi*x) 计算 误差 的 问题 


[1] -0.7071068 
> cos (pi*x) 
[1] -0.7175645 
(22) printtable (x) 函数 ， 支 持 x 为 小 数 。 
> tl «- round (abs (rt (10, df = 1.8) ) , 1) 
> t2 <- round (abs (rt (10, df = 1.4) ) , 1) 
» print.table (table (tl, t2) , zero.print - ".") 
t2 
七 1 


证 口 口 口 口 口 
oo mn 


0:021. 0:4-0.571. 1:2 123: 1.7 842 


(23) 支持 更 多 的 时 间 ， 通 过 OlsonNames () 函数 查看 时 区 列表 ， 用 Sys:timezone () 函数 查看 当前 系统 环境 绑 定 的 时 区 。 
> head (OlsonNames () ) + 时 区 列表 
[1] "Africa/Abidjan" "Africa/Accra" 
[3] "Africa/Addis Ababa" "Africa/Algiers" 
[5] "Africa/Asmara" "Africa/Asmera" 
» Sys.timezone () # 我 的 系统 绑 定 的 时 区 
[1] "Asia/Taipei" 
(24) 系统 支持 64 位 的 time t 类 型 ， 从 而 可 以 方便 地 处 理 超出 32 位 的 时 间 部 分 ， 如 1902 年 以 前 ， 和 2038 以 后 的 时 间 ， 目 前 还 不 支持 OS X 系 统 。 
(25) 目前 time _t 类 型 被 用 于 部 分 的 类 Unit 的 64 位 系统 上 和 Windows 的 64 位 系统 上 。 
(26) 增加 新 的 环境 设置 ，save.defaults 选 项 包括 compression_level 的 配置 。 
(27) colSums () 函数 ， 支 持 数组 和 数据 框 在 2^31 个 元 素 以 上 的 计算 。 
(28) 优化 as.factor () 函数 性 能 ， 加 速 韭 integer 类 型 的 向 量 转换 。 


> a«-rnorm (1000000, -100, 100000) 
> head (a) 


[1] 
[6] -1 
» 
9; 


9856.935 154567.963 -200041.134 . 43363.338 -74436.650 
78322.313 


J 
system.time (as.factor (a) ) HP 系统 ii 
50 0.03 9.64 


(29) 快速 傅立叶 变换 fft () 函数 支持 大 数据 量 计算 ， 从 原来 的 1200 万 个 增加 到 2 亿 个 。 
> x <- 1: 100000000 # 对 1 亿 个 数字 进行 傅立叶 变换 
> system.time (fft (x) ) 
MP ”系统 ”流逝 
32.96 0.22 33.32 
(30) svd () 函数 用 LAPACK 软 件 的 子 程序 ZGESDD 实 现 ， 在 真实 的 环境 下 进行 复杂 的 模拟 计算 。 
(31) 如 果 让 Sweave 输 出 的 .tex 文 件 为 UTF-8 编 码 ， 你 需要 在 LaTex 文 件 中 增加 %\SweaveUTF8 的 设置 。 
(32) 文件 操作 file.copy () 函数 ， 增 加 copy.date () 的 参数 ， 让 复制 的 文件 与 原文 件 有 相同 的 修改 时 间 。 
> file.copy ("a.txt", "b.txt", copy.date=TRUE) + 创建 文件 D.txt 
[1] TRUE 
> file.copy ("a.txt", "c.txt", copy.date=FALSE) + 创建 文件 c.txt 
[1] TRUE 


a.txt 和 b.txt 有 相同 的 文件 修改 时 间 ，c.txt 是 全 新 创建 的 ， 如 图 3-5 所 示 。 


(33) 


(34) 


(35) 


(36) 


缩写 字母 表示 时 区 中 的 时 间 日 期 ， 在 POSIXIt 类 中 设置 可 选 的 参数 zone， 如 巴黎 1940 年 之 前 ， 缩 写 为 LMT，PMT WET 或 WEST。 


gmtoff 组 件 可 以 用 于 记录 GMT 的 偏 移 量 ， 在 支持 的 平台 上 。 


C 语 言 实现 的 strftime () 函数 被 更 新 到 POSIX 2008 标 准 ， 用 于 Windows 和 OS XERA. 


dnorm (x) 函数 计算 结果 更 准确 ， 但 当 |x|> 5 的 时 候 ， 性 能 下 降 。 


> dnorm (rnorm (10, 0, 100) ) # 执行 dnorm () 函数 
[1] 1.151100e-271 0.000000e+00 2.403071e-198 0.000000e+00 


[5] 
[91 


0.000000e*00 3.358647e-208 0.000000e-00 0.000000e*00 
0.000000e*00 1.136764e-154 


,安全 “| 详细 信息 | 以 前 的 版 本 ， 
z b. txt E c. txt 


文件 类 型 : ”文本 文档 (txt) 文件 类 型 : ”文本 文档 〔 txt) 文件 类 型 : ”文本 文档 (txt) 
打开 方式 前 记事 本 打开 方式 : ”出 记事 本 打开 方式 : A 记事 本 


位 置 : D: \workspace\R\basi c\r311 位 置 : D:\workspace\R\basic\r311 í D: \workspace\Ribasic\r311 
大 小 : 8 字 节 (8 字 节 ) 大 小 : 8 zn) 8 字 节 TO 


4.00 KB (4,096 字 节 占用 空间 : 4.00 K (4,096 x5) ; 4,00 KB (4096 zT) 


2014 年 9 月 26 日 ，12:01:51 创建 时 间 : — 2014 年 9 月 26 日 ，12:55:41 创建 时 间 : 2014 年 9 月 26 日 ，12:57:20 
修改 时 间 : 2014 年 9 月 26 日 ，12:57:20 
访问 时 间 : ^ 2014 年 9 月 26 日 ，12:01:51 访问 时 间 : 2014 年 9 月 26 日 ，12:55:41 访问 时 间 : 2014 年 9 月 26 日 ，12:57:20 


属性 : EnEn Eeo 属性 : Emz Meo Ritt: 回 只 读 @)  imO0 


3-5 ”比较 3 个 文件 的 属性 信息 


(37) tiff () 函数 增加 压缩 选项 compression 参 数 。 


» tiff 

function (filename = "Rplot$03d.tif", width = 480, height = 480, units = "px", 
pointsize- 12, compression - c ("none", "rle", "lzw", "jpeg", "zip", "lzwtp", 
"Ziptp") , bg = "white", res = NA, family = "sans", restoreConsole = TRUE, 
type = c ("windows", "cairo") , antialias = c ("default", "none", "cleartype", 


"grey", "subpixel") ) 


(38) read.table () , readLines () 和 scan () 函数 ， 读 取 数 据 时 增加 新 参数 skipNul， 用 于 跳 过 空 值 。 


> readLines 
function (con = stdin (), n = -1L, ok = TRUE, warn = TRUE, encoding = "unknown", 
skipNul = FALSE) 


(39) 赋值 时 ， 避 免 右 侧重 复 值 的 复杂 计算 ， 将 减少 替换 值 的 拷贝 。 


(40) 同时 ， 一 些 其 他 的 变化 ， 也 将 减少 对 象 的 拷贝 。 


(41) KalmanLike () , KalmanRun () 和 KalmanForecast () 函数 的 fast 参 数 被 mod 参 数 替 换 ， 用 于 返回 更 新 后 的 模型 。 


> fit3 <- arima (presidents, c (3, 0, 0)) 

» mod «- fit3$model # 模型 

> pr <- KalmanForecast (4, mod, TRUE) + 执行 卡尔 曼 预 测 函 数 

> mod <- attr (pr, "mod") E 更 新 后 的 模型 ， 保 存在 mod 属 性 中 


(42) arima () 和 makeARIMA () 增加 新 的 参数 SSinit， 计 算 状 态 空间 的 初始 化 的 似 然 函 数 。 


> arima 

function (x, order = c (0L, OL, OL) ， seasonal = list (order = c (0L, OL, OL) ， period 
= NA), xreg = NULL, include.mean = TRUE, transform.pars = TRUE, fixed = NULL, 
init = NULL, method = c ("CSS-ML", "ML", "CSS") , n.cond, SSinit = 
c ("Gardnerl980", "Rossignol2011") , optim.method = "BFGS", optim.control = list () , 
kappa = le+06) 


(43) warning () 函数 增加 新 的 参数 noBreaks， 用 于 简化 输出 处 理 。 


> warning 
function (http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/..., call. = TRUE, immediate. = FALSE, noBreaks. = FALSE, 


(44) pushBack () 函数 增加 新 的 参数 encoding， 支 持 scan () , read.table () 等 函数 读 取 UTF-8 编 码 的 文件 。 


> pushBack 4 检查 PushBack 函 数 定义 

function (data, connection, newLine = TRUE, encoding = c ("", "bytes", "UTF-8") ) 
> zz <- textConnection (LETTERS) # 建 个 文本 通道 

> readLines (zz, ) 

[1] "A" "B" 

» pushBack (c ("aa", "bb") , zz) 4 把 aa，bb 写 入 在 zz 对 象 中 
> pushBackLength (zz) 

[1] 2 

» readLines (zz, 1) 

[1] "aa" 

» pushBackLength (zz) 

[1] 1 

» readLines (zz, 1) 

[1] "bb" 

» readLines (zz, 1) 

[1] "C" 

> close (zz) 


(45) alLequallist () 函数 增加 新 参数 use.names， 通 过 名 字 取 代 索 引 值 来 判断 对 象 是 否 相等 。 


a«-list (a-1, b-2) 

b«-list () 

b[['a'1]«-1 

b[['b'1]«-2 

all.equal.list (a, b) + 相等 

1] TRUE 

b[['a'1]«-4 

all.equal.list (a, b, use.names-TRUE) # 不 相等 
1] "Component "a": Mean relative difference: 3" 


—DVVaVVVVVM 


(46) all.equal () 和 attr.all.equal () 增加 新 参数 check.attributes， 用 


于 比较 列 名 。 


(47) allequal () 函数 增加 了 检查 ， 解 决 了 之 前 未 检查 的 空 参数 引入 的 错误 。 


(48) 把 check.attributes 参 数 用 于 显示 检查 ， 人 允许 NULL 和 numeric 类 型 ， 会 发 现 意 想不到 的 错误 。 


(49) al.equal.numeric () 函数 ， 当 遇 到 比较 的 对 象 长 度 不 一 致 时 ， 会 出 现 “ 规 模 差 异 ” 的 提示 ， 但 不 是 错误 。 


> all.equal.numeric (1: 10, 1: 5) 
[1] "Numeric: lengths (10, 5) differ" 


(50) allequal () 函数 用 POSIXt 方 法 代替 POSIXct 方 法 。 


(51) 用 seq () 函数 生成 Date 和 POSIXt 类 型 的 序列 时 ， 人 允许 使 用 by=quarter 的 分 隔 法 。 


> seq (today, today+365, by="quarter") dE 


[1] "2014-09-26" "2014-12-26" "2015-03-26" "2015-06-26" "2015-09-26" 


> seq (today, today*365, by-"2 months") + 按 2 个 月 


] "2014-09-26" "2014-11-26" "2015-01-26" "2015-03-26" "2015-05-26" 


[1 
[6] "2015-07-26" "2015-09-26" 


(52) file.path () 函数 用 于 适 配 路 径 分 隔 符 ， 这 个 函数 在 我 测试 过 程 中 完全 没有 作 


"c: //abc\\000\\11j/jkh" "c: /abc/a" 


> 
[1 
[3] "d: Nbcd" 


file.path (c ("c: //abc\\000\\11j/jkh", "c: /abc/a", "d: Nbcd") ) 
] 
] 


# 没有 转换 路 径 


(53) 增加 新 函数 agrepl () ， 用 于 模糊 匹配 。 


> agrepl ("laysy", c ("1 lazy", "1", "1 LAZY") , max = 2) 


[1] TRUE FALSE FALSE 


(54) 让 fifo () 函数 支持 Windows 系 统 。 


> capabilities ("fifo") # 检查 系统 是 否 支持 


(55) sortlist (method= "radix") 函数 ， 支 持 基数 排序 ， 用 于 数据 量 很 大 但 值 域 个 数 很 少 的 情况 ， 比 普通 排序 快 很 多 。 


> x«-sample (1: 650, 1e7, replace-TRUE) 

» system.time (ol«-sort.list (x) ) t 普通 排序 用 户 系统 Wo 

7.13 0.02 7.14 

> system.time (o2«-sort.list (x, method="radix") ) # 基数 排序 用 户 系统 流逝 
0.08 0.00 0.07 

> all.equal (ol, o2) # 计算 结果 是 一 致 的 

[1] TRUE 


(56) print.ts () 方法 增加 .preformat.ts () 函数 。 


> x«-sample (1: 650, 1e7, replace-TRUE) 

» system.time (ol«-sort.list (x) ) + 普通 排序 用 户 系统 流逝 

7.13 0.02 7.14 

» system.time (o2«-sort.list (x, method-"radix") ) # 基数 排序 用 户 系统 流逝 
0.08 0.00 0.07 

> all.equal (ol, o2) # 计算 结果 是 一 致 的 

[1] TRUE 


(57) mcparallel () 函数 增加 一 个 参数 detach， 可 以 执行 代码 独立 于 当前 的 会 话 。 它 底 


(58) pdf () 函数 输出 时 ， 将 省 略 非常 小 的 尺寸 圆 和 文字 ， 很 多 用 户 没 有 这 样 的 文件 。 


(59) hist.POSIXIt () 函数 在 用 months，quarters 和 years 分 隔 时 ， 右 边 将 多 加 一 天 。 


(60) data.frame 类 型 ， 支 持 索 引 为 0， 不 报错 。 


mcfork () 函数 设置 参数 estranged=TRUE， 从 而 启动 一 个 子 进程 独立 了 


F 父 进程 运行 。 


> df<-data.frame (1: 5) 
> df[0, ] 

integer (0) 

> df[l1, ] 

[1] 1 


(61) hclust () 函数 增加 ward.D2 的 算法 实现 ， 之 前 的 ward 算 法 改名 为 ward.D。 


> m«-matrix (sample (100, 100, replace-TRUE) , 10) ; m 
bs 11] [s 21 Ts 31 DL, 41 E, 51 EL, 61 D, 7] D, 8] D, 3] 
8 21 93 10 4 40 6 26 55 22 


I. ] 1 

[2, ] 100 85 24 98 94 1 75 70 234 85 
[3,. 1 12 59 12 13 28 72 76 81 94 12 
[4, ] 97 34 21 50 98 26 14 37 72 62 
[55. 1 27 98 14 22 16 90 57 36 50 29 
[6, ] 24 87 22 6 61 68 17 13 27 93 
[75. ] 94 87 64 5 89 81 27 1 18 61 
[8, ] 98 89 5 5 40 26 45 4 36 53 
[9;. ] 34 10 32 31 100 31 64 20 25 85 
(10, ] 19 38 71 72 35 340 75 13 54 94 


» hcl«-hclust (dist (m) , method-"ward.D") ; hcl 
Call: 

hclust (d = dist (m) , method = "ward.D") 
Cluster method  : ward.D 


[, 10] 


Distance : euclidean 
Number of objects: 10 


» hc2«-hclust (dist (m) , method-"ward.D2") ; hc2 


Call: 

hclust (d = dist (m) , method = "ward.D2") 
Cluster method  : ward.D2 

Distance : euclidean 


Number of objects: 10 


> plot (hcl) # 画图 ， 如 图 3-6 所 示 


> plot (hc2) 


Cluster Dendrogram 
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dist(m) 
hclust (*, "ward.D2") 


$6 ”比较 2 个 聚 类 算法 的 差异 


(62) sunspot.month 数 据 集 更 新 ，sunspot.year 数 据 集 保持 不 变 。 


> head (sunspot .month) 
[1] 58.0 62.6 70.0 55.7 85.0 83.5 
> head (sunspot.year) 
[1] 5 11 16 23 36 58 


(63) summary () 函数 对 于 Im () 一 元 线性 回归 的 拟 合 会 发 出 警告 ， 


因为 有 时 候 计算 会 不 准确 ， 这 与 平台 相关 。 我 在 Windows 中 测试 时 ， 没 有 发 现 警告 。 


ctl «- c (4.17, 5.58, 5.18, 6.11, 
trt «- c (4.81, 4.17, 4.41, 3.59, 
group <- gl (2, 10, 20, labels 
weight «- c (ctl, trt) 

lm.D9 «- lm (weight ~ group) 
summary (lm.D9) 

Call: 

lm (formula = weight ~ group) 
Residuals: 


Vvvvvyv 


pos 


.50, 4.61, 5.17, 4.53, 5.33, 5.14) 
.87, 3.83, 6.03, 4.89, 4.32, 4.69) 
c ("Ct1", "Trt") ) 


Min 10 Median 3Q Max 
-1.0710 -0.4938 0.0685 0.2462 1.3690 
Coefficients: 

Estimate Std. Error t value Pr (»|t|) (Intercept) 5.0320 0.2202 22.850 9.55e-15 *** 

groupTrt -0.3710 0.3114 -1.191 0.249 
Siguif..oodes; Q MW Q gol trer TDi ter 0,05 *,' 0,1 ""* 1 
Residual standard error: 0.6964 on 18 degrees of freedom 
Multiple R-squared: 0.07308, Adjusted R-squared: 0.02158 


F-statistic: 1.419 on 1 and 18 DF, 


p-value: 0.249 


(64) 在 编程 中 ， 提 取 summary () 函数 计算 出 数据 时 ， 最 好 封装 在 suppressWarnings () 函数 中 。 


> suppressWarnings (summary (lm.D9) $cov.unscaled) 
(Intercept) groupTrt (Intercept) 0.1 -0.1 


groupTrt -0.1 0.2 


终于 把 这 64 项 更 新 都 整理 完了 ， 这 些 更 新 很 多 都 与 性 能 相关 ， 另 外 一 块 是 语法 上 的 优化 ， 看 得 出 R 语 言 工作 的 重点 方向 。 
3.53 ”R 语 言 3.1.1 新 特性 及 代码 描述 


R 语 言 3.1.1 版 本 的 别名 是 Sock it to Me， 很 有 意思 。 下 载 R3.1.1 版 本 后 ， 你 可 以 通过 version 来 查看 版 本 信息 。 


~R + 启动 R 程 序 

> version # 查看 版 本 信息 
Platform x86 64-w64-mingw32 
arch x86 64 

os mingw32 

system x86 64, mingw32 
status 

major 5 

minor 1.1 

year 2014 

month 07 

day 10 

svn rev 66115 

language R 

version.string R version 3.1.1 (2014-07-10) 
nickname Sock it to Me 


R3.1.1 版 本 有 以 下 17 个 新 特性 。 


(1) attach () 函数 的 冲突 提示 , 与 library () 函数 信息 提示 是 相似 的 ， 都 使 用 message () 函数 来 实现 。 


> w«-women # 把 women 赋 值 给 w 
>w 
height weight 
1 58 115 
2 59 117 
3 60 120 
4 61 123 
5 62 126 
6 63 129 
7 64 132 
8 65 135 
9 66 139 
10 67 142 
11 68 146 
12 69 150 
13 70 154 
14 71 159 
15 72 164 
> attach (w) + 加 载 w 数 据 集 
> height # 直接 使 用 数据 集中 的 height 列 
[1] 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 
> attach (women) + 加 载 Women 数 据 集 ， 列 名 变量 发 生 冲 突 


The following objects are masked from w: 

height, weight 
» library (xts) # Library 包 加 载 冲突 提示 载 入 需要 的 程 辑 包 : zoo 载 入 程 辑 包 : 'zoo' 
The following objects are masked from 'package: base': 

as.Date, as.Date.numeric 


(2) RCMD Sweave 命 令 ， 默 认 不 再 删除 任何 文件 ， 并 增加 --clean 参 数 设 置 ，--clean=default 和 --clean=keepOuts。 


^ C: \Users\Administrator>R CMD Sweave 
Usage: R CMD Sweave [options] file 
A front-end for Sweave and other vignette engines, via buildVignette () 


Options: 
-h, --help print this help message and exit 
-v, --version print version info and exit 
--driver-name use named Sweave driver 
--engine-pkg: : engine use named vignette engine 
--encoding-enc default encoding 'enc' for file 
--clean corresponds to --clean-default 
--clean- remove some of the created files: 
"default" removes those the same initial name; 
"keepOuts" keeps e.g. *.tex even when PDF is produced 
--options- comma-separated list of Sweave/engine options 
--pdf convert to PDF document 
—-compact- try to compact PDF document: 
"no" (default) , "qpdf", "gs", "gs*qpdf", "both" 
—-compact same as --compact-qpdf 


Report bugs at bugs.r-project.org 


(3) tools&buildVignette () 函数 和 buildVignettes () 函数 ， 当 clean 参 数 为 FALSE 时 ， 不 再 删除 新 创建 的 文件 。 


> library (tools) 
> buildVignette 
function (file, dir = weave = TRUE, latex = TRUE, tangle = TRUE, 
quiet = TRUE, clean = TRUE, keep = character () , engine = NULL, 
buildPkg = NULL, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 


(4) 在 Bioconductor 版 本 中 使 用 setRepositories () 函数 ， 可 以 通过 环境 变量 R_BIOC_VERSION 在 运行 时 设置 ， 原 来 只 能 在 R 软 件 安装 时 设置 (Bioconductor 的 版 本 将 从 2.14 升 级 到 3.0) 。 


(5) 谋 入 在 Sweave 文 件 的 Sexpr 代 码 的 bug 的 错误 信息 ， 会 显示 源 代码 错误 位 置 。 


(6) type.convert () 函数 、read.table () 函数 或 read.* () 函数 ， 都 增加 了 一 个 新 的 参数 numerals， 可 以 在 读数 据 的 时 候 直接 转型 成 double， 并 设置 数字 精度 。 


> type.convert 

function (x, na.strings = "NA", as.is = FALSE, dec = ".", numerals = c ("allow.loss", \ 
"warn.loss", "no.loss") ) 

.External2 (C typeconvert, x, na.strings, as.is, dec, match.arg (numerals) ) 

Xbytecode:  0x0000000008e15948» 

«environment: namespace: utils» 


(7) 增加 R 语 言 内 部 代码 的 健壮 性 ， 修 正 一 些 编译 器 ， 解 决 了 加 法 溢出 无 异常 提示 的 问题 。 


> as.integer (2000000000) +as.integer (2000000000) 

[1] NA 

Warning message: 

In as.integer (2e*09) + as.integer (2e*09) : NAs produced by integer overflow 


(8) smooth.spline () 函数 的 knots 参 数 默 认 值 改 为 .nknots.smspl。 


> smooth.spline 
function (x, y = NULL, w = NULL, df, spar = NULL, cv = FALSE, 
all.knots = FALSE, nknots = .nknots.smspl, keep.data = TRUE, 
df.offset = 0, penalty = 1, control.spar = list () , tol = 1le-06 * IQR (x) ) 


(9) Beta 分 布 函数 dbeta (, a, b) ` pbeta () ` qbeta () 和 rbeta () 的 参数 a 和 b 默 认 值 改 为 0， 原 来 是 NaN。a 和 b 对 应 的 参数 为 shape1 和 shape2。 


> dbeta 
function (x, shapel, shape2, ncp = 0, log = FALSE) 


if (missing (ncp) ) 
.External (C dbeta, x, shapel, shape2, log) 
else .External (C dnbeta, x, shapel, shape2, ncp, log) 


} 
<bytecode: 0zx000000000d54c070> 
<environment: namespace: stats? 


(10) RStudio 的 图 形 设备 不 能 正常 使 用 dev.new () ERE, f&dev.new () 函数 增加 新 的 参数 noRStudioGD， 蔡 换 原来 的 默认 选择 ， 从 而 实现 在 Rstudio 中 图 形 设备 的 开发 。 


> dev.new () # 警告 错误 

NULL 

Warning message: 

In (function () : Only one RStudio graphics device is permitted 
> dev.new (noRStudioGD-TRUE) # 弹出 新 窗口 ， 运 行 正 确 


(11) 增加 readRDS () 函数 ， 用 于 读 取 rds 格 式 的 数据 文件 。 


> d«-data.frame (a-1: 10, b-10: 1) 

» saveRDS (d, "d.rds") # 把 d 数 据 框 ， 以 rds 格 式 保存 
> d2«-readRDS ("d.rds") + 读 取 rds 数 据 

> d2 
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(12) 当 修改 内 部 逻辑 标量 常数 的 时 候 ， 会 提示 错误 ， 原 来 是 警告 。 


> pi + 常数 pi 

[1] 3.141593 

> pi<<-3.2 + 修改 常数 pi 会 出 错 
Error: cannot change value of locked binding for 'pi' 


(13) install.packages (reposz NULL) 函数 ， 支 持 http 或 ftp 协 议 的 下 载 并 安装 新 包 。 


> install.packages ("plyr", repos = "http: //cran.rstudio.com/") 
trying URL 'http: //cran.rstudio.com/bin/windows/contrib/3.1/plyr 1.8.1.zip' 
Content type 'application/zip' length 1151983 bytes (1.1 Mb) 
opened URL 
downloaded 1.1 Mb 
package 'plyr' successfully unpacked and MD5 sums checked 
The downloaded binary packages are in 
C: NUsersMVAdministratorVAppDataNLocalNTempNRtmpWEXnOTNdownloaded packages 


(14) 当 R 环 境 变 量 options ("warnPartialMatchDollar") 为 TRUE 时 ， 数 据 框 用 $ 符 号 部 分 匹配 会 出 现 警 告 。 


> options ("warnPartialMatchDollar") # 默认 值 
$warnPartialMatchDollar 

NULL 

> options (warnPartialMatchDollar = TRUE) # 赋值 设 为 TRUE 


> options ("warnPartialMatchDollar") 
$warnPartialMatchDollar 

[1] TRUE 

> df <- data.frame (ab-1: 4, cd-1: 4) 

> rownames (df) <- paste0 (letters[1: 4], "a") 


» df$a # 警告 

[111234 

Warning message: 

In ^$.data.frame' (df, a) : Partial match of 'a' to 'ab' in data frame 
> d£["a", ] # 另 一 种 调用 方法 


(15) 通过 packagefoo 的 语法 来 查询 包 的 信息 ， 而 不 管 包 是 否 被 加 载 。 


> search () + 当前 环境 已 加 载 的 包 ， 不 包括 plyr 
[1] ".GlobalEnv" "tools: rstudio" 


[4] "package: graphics" "package: grDevice ackage: utils" 
[7] "package: datasets" "package: methods" "Autoloads" 

[10] "package: base" 

> packageplyr # 可 以 直接 打开 plyr 的 包 才 助 


> packagepryr 
Error in `` (package, pryr) 


注意 ， 没 有 种 类 为 “package” 和 名 为 “pryr 的 文件 (或 是 在 处 理 帮助 文件 时 发 生 了 错误 ) 。 


(16) 调用 R 的 帮助 ， 现 在 默认 会 尝试 所 有 加 载 的 包 ， 而 不 仅仅 是 在 搜索 路 径 。 


> help (package-"zoo") # 查看 未 加 载 包 的 信息 
> zoo # 查看 未 加 载 包 中 ， 所 有 名 字 匹 配 的 函数 


(17) 增加 promptlmport () 函数 ， 用 于 从 其 他 包 导 出 一 个 帮助 文件 。 


> promptImport (cat) * 导出 cat 函 数 的 帮助 文件 


建立 一 名 字 叫 'catRd' 的 文件 。 修 改 文 件 再 把 它 放 到 合适 的 目录 中 去 。 查 看 生成 cat.Rd 文 件 。 


Mname (cat ) 
Nalias(cat) 


NdocType (import) 
Ntitle(Import from package \pkg{base}} 


Ndescription( 
The Ncode(cat) object is imported from package WMpkg(base]. 
Help is available here: Ncode(M.ink[base: cat](base: : cat}}. 


} 


对 于 R 3.1.1 版 本 的 更 新 ， 一 部 分 增加 新 功能 ， 另 外 有 些 更 新 其 实 是 在 给 3.1.0 版 本 修补 bug。 


对 于 想 深入 学 习 R 语 言 的 用 户 来 说 ， 每 次 更 新 升级 都 需要 看 一 遍 新 特性 列表 ， 真 是 很 有 必要 的 ， 很 多 时 候 都 可 以 解决 我 们 实际 遇 到 的 问题 。 比 如 ，R3.1.1 版 本 第 10 个 更 新 对 Rstudio 图 形 输出 的 支持 ， 就 


可 以 解决 我 在 Rstudio 中 由 于 图 形 设备 环境 出 错 ， 不 能 启动 游戏 界面 的 问题 。 


补充 一 句 ， 由 于 每 个 更 新 点 官方 仅 有 一 句 话 描述 ， 而 我 的 知识 水 平 有 限 ， 也 并 不 是 所 有 都 能 理解 ， 书 中 难免 有 理解 错误 的 地 方 ， 如 果 有 读者 发 现 错误 ， 还 请 指教 。 


第 4 章 面向 对 象 编程 


本 章 详 细 介 绍 了 R 语 言 中 面向 对 象 的 编程 思路 ， 以 及 4 种 面向 对 象 体系 结构 的 编程 实现 ， 帮 助 读者 深入 理解 R 语 言 的 面向 对 象 编程 ， 并 有 能 力 构建 出 复杂 的 业务 应 用 。 


44 ”R 语 言 面 向 对 象 编程 


R 语 言 面向 对 象 编程 
http://blog.fens.me/r-object-oriented-intro/ 


面向 对 象 是 一 种 对 现实 世界 理解 和 抽象 的 方法 ， 当 代码 复杂 度 增加 以 致 难以 维护 的 时 候 ， 面 向 对 象 就 会 显得 非常 重要 。 我 经 历 过 Java 和 JavaScript 两 种 语言 从 面向 过 程 到 面向 对 象 思路 的 改造 ， 并 感觉 这 种 
变化 也 会 出 现在 R 语 言 中 。 在 工业 界 的 引导 下 ，R 将 走向 大 规模 的 企业 应 用 ， 因 此 面向 对 象 的 编程 方式 将 成 为 R 语 言 的 一 种 非常 重要 的 发 展 方向 。 


4.1.1 什么 是 面向 对 象 


面向 对 象 是 指 一 种 程序 设计 范 型 ， 同 时 也 是 一 种 程序 开发 的 方法 。 面 向 对 象 的 对 象 指 的 是 类 的 集合 ， 把 对 象 作为 程序 的 基本 单元 ， 将 程序 和 数据 封装 其 中 ， 以 提高 软件 的 重用 性 、 灵 活性 和 扩展 性 。 面 
向 对 象 是 一 种 对 现实 世界 理解 和 抽象 的 方法 ， 是 计算 机 编程 技术 发 展 到 一 定 阶段 的 产物 。 早 期 的 计算 机 编程 是 基于 面向 过 程 的 方法 ， 例 如 实现 算术 运算 2+3+4=9， 通 过 设计 一 次 运算 就 可 以 计算 出 结果 。 


随 着 计算 机 技术 的 不 断 发 展 ， 计 算 机 被 用 来 解决 越 来 越 复杂 的 问题 。 一 切 事物 镍 对 象 ， 通 过 面向 对 象 的 方法 ， 将 现实 世界 的 导 


物 抽象 成 对 象 ， 现 实 世界 中 的 关系 抽象 成 对 象 之 间 的 关系 ， 如 继承 关系 ， 


从 而 帮助 人 们 实现 对 现实 世界 的 抽象 与 数字 建 模 。 通 过 面向 对 象 的 方法 ， 更 方便 利用 人 们 理解 的 复杂 系统 的 分 析 、 设 计 与 编程 过 程 。 同 时 ， 面 向 对 象 能 有 效 提高 编程 的 效率 ， 通 过 封装 、 继 承 、 多 态 的 抽 


象 ， 可 以 像 搭 积木 一 样 快速 开发 出 一 个 全 新 的 系统 。 


1. 面 向 对 象 的 三 个 特征 


面向 对 象 的 三 个 特征 是 封装 、 继 承 、 多 态 。 封 装 是 把 客观 事物 封装 成 抽象 的 类 ， 并 且 类 可 以 把 自己 的 数据 和 方法 只 让 可 信 的 类 或 者 对 象 操作 ， 对 不 可 信 的 类 或 对 象 操作 进行 信息 隐藏 。 一 个 封装 实例 ， 
如 图 4-1 所 示 。 


图 4-1 封装 


我 们 通过 面向 对 象 的 思想 ， 定 义 老师 和 学 生 两 个 对 象 ， 并 分 别 定义 老师 和 学 生 的 行为 。 


. 老师 的 行为 : 讲课 、 布 置 作业 、 批 作业 。 
- 学 生 的 行为 : 听课 、 写 作业 、 考 试 。 


通过 封装 就 把 两 个 客观 事物 进行 了 抽象 ， 并 设置 了 对 象 的 行为 。 


继承 是 子 类 自动 共享 父 类 数据 结构 和 方法 的 机 制 ， 这 是 类 之 间 的 一 种 关系 。 在 定义 和 实现 一 个 类 的 时 候 ， 可 以 在 一 个 已 经 存在 的 类 的 基础 之 上 进行 ， 使 用 现 有 类 的 所 有 功能 ， 并 在 无 需 重新 编写 原来 的 
类 的 情况 下 对 这 些 功能 进行 扩展 。 通 过 继承 创建 的 新 类 称 为 “ 子 类 ”或 “派生 类 ” ; 被 继承 的 类 称 为 “ 基 类 ”、“ 父 类 ”或 “ 超 类 ”。 一 个 继承 实例 ， 如 图 4-2 所 示 。 


WERO 


写作 业 0 
+ 考试 () 
7N 


LU: 
9 E 
BEERRETENEO NENNEN 


图 4-2 ”继承 


通常 每 门 课 都 会 从 学 生 中 选 出 这 门 课 的 课 代表 ， 来 帮助 老师 和 其 他 同学 沟通 。 课 代表 会 比 普通 同学 有 更 多 特权 。 通 过 继承 关系 ， 把 普通 同学 和 课 代表 区 别 为 两 个 子 类 ， 课 代表 不 仅 有 普通 同学 的 行为 ， 
还 有 帮助 老师 批 作业 的 行为 。 


多 态 是 指 由 继承 而 产生 的 相关 的 不 同 的 类 ， 其 对 象 对 同一 消息 会 做 出 不 同 的 响应 。 一 个 多 态 实例 ， 如 图 4-3 所 示 。 


图 4-3 $5 


期 未 考试 时 ， 总 有 考 得 好 的 同学 和 考 得 不 好 的 同学 。 所 以 ， 对 于 优等 生来 说 ， 他 的 考试 结果 是 优 ， 对 次 等 生来 说 ， 考 试 结果 就 不 是 太 好 。 相 同行 为 对 于 由 继承 而 产生 的 相关 的 不 同 的 对 象 ， 结 果 是 不 同 
的 。 所 以 ， 通 过 面向 对 象 的 思想 ， 我 们 可 以 把 客观 世界 的 事物 进行 抽象 。 


2.is a 和 has a 


在 客观 世界 中 有 若 


类， 这 些 类 之 间 有 一 定 的 结构 关系 。 通 常 有 两 种 主要 的 结构 关系 : is a 和 has a. 


“isa: 为 继承 关系 ， 比 如 鞭 形 、 圆 形 和 方形 都 是 一 种 形状 。 


“has a: 为 组 合 关 系 或 聚合 关系 ， 比 如 电脑 由 显示 器 、CPU、 硬 盘 等 组 成 。 


412 ”R 为 什么 要 进行 


J 面向 对 象 编程 


R 主 要 面向 统计 计算 ， 而 且 代码 量 一 般 不 会 很 大 ， 也 就 几 十 行 或 几 百 行 ， 使 用 面向 过 程 的 编程 方法 就 可 以 很 好 地 完成 编程 的 任务 。 但 R 语 言 的 持续 走 热 ， 并 伴随 着 越 来 越 多 拥有 工程 背景 的 人 加 入 ，R 语 
言 开 始 向 更 多 的 领域 发 展 。 原 来 少量 代码 的 面向 过 程 的 编码 方式 ， 会 越 来 越 难 以 维护 具有 海量 代码 的 项 目 ， 所 以 必须 有 一 种 新 的 编程 方式 来 取代 原来 的 面向 过 程 的 编码 思路 ， 这 种 新 的 编程 方式 就 是 面向 对 


象 编程 (Object Oriented Programming, OOP) 。 


面向 对 象 编程 ， 早 在 C+ +/Java 时 代 就 被 广泛 使 用 了 ， 几 乎 90% 以 上 的 Java 框 架 都 是 按 面向 对 象 的 方法 设计 的 ; 8 年 前 Javascript 的 各 种 面向 过 程 编码 让 前 端 开发 


端 出 现 ， 才 让 大 家 认识 到 
领域 。 


当 R 语 言 被 大 家 所 看 


我 想 这 个 
思 


答 
面向 对 象 思路 进行 R 包 的 


案 就 是 以 面向 对 象 的 方式 进行 编程 ， 现 在 的 R 就 像 8 
行 


困难 和 


看 ， 直 到 Google 的 Gmail 


Web 


原来 JavaScript 也 可 以 面向 对 象 编程 ， 随 后 的 jQuery、ExtJS 等 类 库 的 完全 面向 对 象 的 实现 ， 终 于 让 JavaScript 撑 得 起 前 端的 天 空 ， 后 来 的 Node.js 的 诞生 更 是 让 JavaScript 拓 宽 了 应 


好 的 同时 ， 我 们 也 要 开始 思考 ， 如 何 才能 让 R 成 为 工业 界 的 开发 语言 ”用 R 语 言 如 何 构建 非 统计 计算 的 项 目 ” 如 何 用 R 有 效 地 编写 10 万 行 以 上 的 代码 ? 


开发 了 。 关 于 以 面向 对 象 思想 开发 的 R 包 memoise， 请 参考 《R 的 极 客 理想 一 一 工具 篇 》 一 书 的 3.1 节 。 


4.1.3 ”R 的 面向 对 象 编程 


FEF 前 的 JavaScript， 需 要 大 公司 和 和 牛人 来 推动 。 从 我 的 观察 来 看 ， 以 Hadley Wickham 为 代表 的 R 语 言 领军 人 物 已 经 开始 在 R 包 中 全 面 引 入 


R 语 言 中 有 三 种 面向 对 象 的 编程 实现 ， 即 33 类 型 、S4 类 型 和 RC 类 型 。S3 和 S4 都 是 基于 泛 型 函数 的 ，RC 则 是 完全 的 面向 对 象 实现 。 这 三 种 面向 对 象 类 型 的 使 用 ， 在 本 章 中 都 会 介绍 ， 而 本 节 以 S3 类 型 为 
切入 点 ， 接 下 来 介绍 的 面向 对 象 的 实现 方式 都 是 基于 S3 类 型 来 说 的 。 


R 语 言 中 基于 S3 类 型 
老师 和 学 生 的 三 幅 图 。 


1.R 语 言 实现 封装 


的 面向 对 象 编程 是 通过 泛 型 函数 (generic function) 实现 的 ， 而 不 是 基于 类 层次 结构 。 接 下 来 ， 我 从 面向 对 象 的 三 个 特征 入 手 ， 分 别 


定义 老师 对 象 和 行为 ， 封 装 到 teacher () 泛 型 函数 中 ; 定义 同学 对 象 和 行为 ， 封 装 到 student () 泛 型 函数 中 。 


R 语 


A 


进 : 


1 


TM, (F 


的 案例 为 前 


H 


提 到 的 


# 定义 老师 对 象 和 行为 


> teacher «- funct 


ion (x, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 


UseMethod ("teacher") 


> teacher.lecture «- function (x) print ("讲课 ") 

> teacher.assignment «- function (x) print ("布置 作业 ") 

> teacher.correcting «- function (x) print ("批改 作业 ") 

> teacher.default«-function (x) print ("你 不 是 teacher") 

# 定义 同学 对 象 和 行为 

> student <- function (x, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) UseMethod ("student") 
> student.attend «- function (x) print ("听课 ") 

> student.homework «- function (x) print ("写作 业 ") 

> student.exam «- function (x) print ("考试 ") 

> student.default«-function (x) print ("4&4 student") 

# 定义 两 个 变量 ，a 老 师 和 b 同 学 

> a«-'teacher' 

> b«-'student' 

> attr (a, 'class') <- 'lecture' E 给 老师 变量 设置 行为 
> teacher (a) # 执行 老师 的 行为 

1] "讲课 " 

> attr (b, 'class') <- 'attend' # 给 同学 变量 设置 行为 
> student (b) # 执行 同学 的 行为 

1] "听课 " 

> attr (a, 'class') «- 'assignment' 4 重 置 老师 变量 的 行为 
> teacher (a) # 执行 老师 的 行为 

1] "布置 作业 " 

> attr (b, 'class') «- 'homework' + 重 置 同学 变量 的 行为 
> student (b) # 执行 同学 的 行为 

1] "写作 业 " 

> attr (a, 'class') «- 'correcting' 

» teacher (a) 

1] "批改 作业 " 

> attr (b, 'class') «- 'exam' 

> student (b) 

1] "考试 " 


如 果 我 们 把 老师 和 同学 的 行为 都 赋予 到 一 个 变量 上 ， 会 是 什么 样 呢 ? 


> ab«-'student teacher' # 定义 一 个 变量 ， 既 是 老师 又 是 同学 

> attr (ab, 'class') <- c ('lecture', 'homework') # 分 别 设置 不 同 对 象 的 行为 
> teacher (ab) # 执行 老师 的 行为 

[1] "讲课 " 

> student (ab) # 执行 同学 的 行为 

[1] "写作 业 " 


从 执行 结果 可 以 看 到 ， 这 个 同时 有 老师 和 同学 的 行为 变量 ab， 被 teacher () 泛 型 函数 调用 时 就 是 老师 的 行为 ， 被 student () 泛 型 函数 调用 时 就 是 同学 的 行为 。 


2.R 语 言 实现 继承 


我 们 增加 一 个 同学 作为 课 代表 ， 并 给 课 代表 增加 帮助 老师 批改 作业 的 行为 ， 可 以 通过 继承 来 构造 两 个 实例 ， 用 于 区 分 课 代表 与 普通 同学 。 


} 


return (mro) 


} 
NewInstance <- function (value=0, classes=char0, parents=char0) { 


# 定义 构造 函数 ， 创 建 对 象 


> student.correcting <- function (x) print ("帮助 老师 批改 作业 ") # 给 同学 对 象 增加 新 的 行为 
> char0 = character (0) + 辅助 变量 用 于 设置 初始 值 
> create <- function (classes=char0， Parents=char0) { # 实现 继承 关系 
+ mro <- c (classes) 

+ for (name in parents) { 

+ mro <- c (mro, name) 

+ ancestors <- attr (get (name) , 'type') 

+ mro <- c (mro, ancestors [ancestors ! = name]) 

+ 

T 

4 

> 


+ obj <- value 

+ attr (obj, 'type') <- create (classes, parents) 

+ attr (obj, 'class') <- c ('attend', 'homework', 'exam') 

+ return (obj) 

+} 

> StudentObj <- NewInstance () # 创建 父 对 象 实例 

> sl <- NewInstance (' 普 通 同学 ',，classes='normal',， parents-'StudentObj') 
5 创建 子 对 象 实例 

> s2 <- NewInstance (' 课 代表 '，classes='leader',， parents-'StudentObj') 

> attr (s2, 'class') «- c (attr (s2, 'class') , 'correcting') E 给 课 代表 增加 批改 作业 的 行为 

> sl * 查看 普通 同学 的 对 象 实例 

[1] "普通 同学 " 

attr (, "type") 

[1] "normal" "StudentObj" 

attr (, "class") 

[1] "attend" "homework" "exam" 

> s2 # 查看 课 代表 的 对 象 实例 

[1] "RRA" 

attr (, "type") 

[1] "leader" "StudentObj" 

attr (, "class") 

[1] "attend" "homework" "exam" "correcting" 

3.R 语 言 实现 多 态 


期 未 考试 时 ， 有 的 同学 考试 成 绩 好 ， 有 的 同学 考试 成 绩 不 好 ， 我 们 通过 继承 构造 出 优等 生 和 次 等 生 两 个 实例 。 两 个 实例 有 相同 行为 ， 但 对 于 考试 的 结果 是 不 同 的 ， 这 样 就 体现 出 了 多 态 的 特征 。 


> el <- NewInstance (' 优 等 生 '，classes='excellent', parents-'StudentObj') 
# 创建 优等 生 和 次 等 生 两 个 实例 


> e2 <- NewInstance ('x#ẸÆ', classes-'poor', parents-'StudentObj') 

> student.exam <- function (x, score) { E 修改 同学 考试 的 行为 ， 大 于 85 分 结果 为 优秀 ， 
o1 T7028 R4 RA 

E p<-" 考 试 " 

+ if (score>85) print (paste (p, "优秀 "，sep="") ) 

+ if (score<70) print (paste (p, "及 格 "，sep="") ) 

+} 

> attr (el, 'class') <- 'exam' E 执行 优等 生 的 考试 行为 ， 并 输入 分 数 为 90 

> student (el, 90) 

n] "考试 优秀 " 

> attr (e2, 'class') «- 'exam' d 执行 次 等 生 的 考试 行为 ， 并 输入 分 数 为 66 

> student (e2，66) 

[1] "考试 及 格 " 


这 样 通过 R 语 言 S3 类 型 的 泛 型 函数 ， 我 们 就 实现 了 面向 对 象 的 编程 。 


4.R 的 面向 过 程 编程 
接 下 来 ， 为 了 对 比 ， 我 们 用 R 语 言 的 面向 过 程 的 代码 实现 上 面 的 逻辑 。 
(1) 定义 老师 和 同学 两 个 对 象 以 及 对 应 的 行为 
> char0 = character (1) + 辅助 变量 用 于 设置 初始 值 
> teacher fun<-function (x=char0) { # 定义 老师 对 象 和 行为 
+ if (x—'lecture') ( 
print (" 讲 课 " 


}else if (x--'assignment') { 
print ("布置 作业 ") 
}else if (x--'correcting') { 


十 十 十 十 


print ("批改 作业 ") 
}else{ 
print ("4k teacher") 
; } 
student fun<-function (x=char0) { # 定义 同学 对 象 和 行为 
if (x--'attend') ( 
print ("听课 ") 
}else if (x—'homework') { 
print ("写作 业 ") 
}else if (x--'exam') { 
print ("考试 中 
Jelset 
print ("f student") 


} 


} 

teacher fun ('lecture') # 执行 老师 的 一 个 行为 
1] "讲课 " 

student fun ('attend') * 执行 同学 的 一 个 行为 

] "听课 


于 VV++ 十 十 十 十 十 十 十 十 V+ 十 十 十 + 


1 


(2) 区 别 普通 同学 和 课 代表 的 行为 


> student fun<-function (x=char0, role=0) { + 重 定义 同学 的 函数 ， 增 加 角色 判断 
+ if (x=='attend') { 

十 print ("听课 ") 

+ }else if (x=='homework') { 

+ print ("54E 3b") 

* am') ( 

十 print ("考试 ") 

* Jelse if (x--'correcting') ( 

* if (role--1) {# 课 代表 

十 print ("帮助 老师 批改 作业 ") 

* Jelset 
4 
十 
十 
本 
十 
4 
> 
[ 
> 
[ 


print (" 你 不 是 课 代 表 ") 
} 

Jelset 
print ("你 不 是 student") 

} 


} 

student fun ('correcting') * 以 普通 同学 的 角色 ， 执 行 课 代 表 的 行为 
1] "你 不 是 课 代 表 " 

student fun ('correcting', 1) E 以 课 代 表 的 角色 ， 执 行 课 代 表 的 行为 

] 


1] "帮助 老师 批改 作业 " 


我 在 修改 student fun () 函数 的 同时 ， 已 经 增加 了 原 函 数 的 复杂 度 。 


(3) 参加 考试 ， 以 成 绩 区 别 出 优 等 生 和 次 等 生 


> student fun<-function (x-char0, role-0, score) ( # 修改 同学 的 函数 定义 ， 增 加 考试 成 绩 参 数 
十 if (x--'attend') ( 

* print ("听课 ") 

+ }else if (x: homework') ( 

十 print ("写作 业 ") 

* }else if (x—'exam') { 

n p<-" 考 试 " 

+ if (score>85) print (paste (p, "优秀 "，sep="") ) 
十 if (score«70) print (paste (P，" 及 格 "，sep="") ) 
* Jelse if (x--'correcting') { 

* if (role--1) { HERA 

+ print ("帮助 老师 批改 作业 ") 
n 

n 

n 

十 

十 

十 

十 

> 

[ 

E 

[ 


Jelset 
print (" 你 不 是 课 代表 ") 
} 
Jelset 
print ("4k student") 


j 

student fun ('exam', score-90) E 执行 考试 函数 ， 考 试 成 绩 大 于 85 分 ， 为 优等 生 
1] "考试 优秀 " 

student fun ('exam', score-66) # 执行 考试 函数 ， 考 试 成 绩 小 于 70 分 ， 为 次 等 生 

] "ARAK" 


我 再 一 次 用 面向 过 程 的 代码 实现 了 整个 编辑 逻辑 。 在 用 面向 过 程 来 写 程序 的 时 候 ， 每 一 次 的 需求 变化 都 需要 对 原始 代码 进行 修改 ， 不 仅 增 加 了 代码 复杂 度 ， 而 且 不 利于 长 久 维护 。 更 多 思考 留 给 大 家 ! 


本 节 抛 砖 引 玉 地 讲 了 R 语 言 的 面向 对 象 的 编程 ， 其 中 部 分 代码 有 些 不 够 严谨 ， 本 节 只 希望 给 大 家 思路 上 的 认识 ， 更 具体 的 面向 对 象 编程 实例 会 在 下 一 节 中 详细 介绍 。 


42 ”R 语 言 基 于 S3 的 面向 对 象 编程 


问题 


如 何 基于 S3 系 统 进行 面向 对 象 编程 ? 


— 


UseMethod 


— 


getS3method 


up 


R 语 言 基于 S3 的 面向 


http://blog.fens.me/r-class-s3/ 


K m IR 


就 面向 对 象 编 程 ，R 语 言 不 同 于 其 他 的 编程 语言 ，R 语 言 提供 了 三 种 底层 对 象 系统 ， 一 种 是 S3 类 型 ， 一 种 是 S4 类 型 ， 还 有 一 种 是 RC 类 型 。S3 对 象 简单 ， 具 有 动态 性 ， 但 结构 化 特征 不 明显 ; S4 对 象 结构 
化 ， 功 能 强大 ; RC 对 象 是 2.12 版 本 后 使 用 的 新 类 型 ， 用 于 解决 S3 和 S4 很 难 实 现 的 对 象 设计 。 本 节 将 从 S3 对 象 开始 ， 介 绍 R 语 言 面向 对 象 编程 的 细节 。 


4.2.1 创建 S3 对 象 


在 R 语 言 中 ， S3 对 象 的 面向 对 象 编程 ， 是 一 种 基于 泛 型 函数 的 实现 方式 。 泛 型 函数 是 一 种 特殊 的 函数 ， 根 据 传 入 对 象 的 类 型 决定 调用 哪个 具体 的 方法 。 基 于 S3 对 象 实现 的 面向 对 象 编程 ， 不 同 于 


他 语言 的 面向 对 象 编程 ， 是 一 种 动态 函数 调用 的 模拟 实现 。S3 对 象 被 广泛 应 用 于 R 的 早期 的 开发 包 中 。 关 于 面向 对 象 的 基础 知识 介绍 ， 请 参看 4.1 节 。 


本 节 的 系统 环境 是 : 
: Linux: Ubuntu Server 12.04.2 LTS 64bit 


«R: 3.1.1 x86. 64-pc-linux-gnu. (64-bit) 


为 了 方便 我 们 检查 对 象 的 类 型 ， 引 入 pryr 包 作为 辅助 工 


。 关 于 pryr 包 的 介绍 ， 请 参看 3.1 节 。 


R 
> library (pryr) 


# 启动 R 程 序 
# 加 载 pryr 包 


1. 通 过 变量 创建 $53 对象 


创建 $3 对象 最 简单 的 方法 就 是 给 一 个 变量 增加 class 属 性 。 


> x<-1 # 定义 变量 


> attr (x, 'class') «-'foo' # 定义 为 S3 类 型 对 象 


>x # 查看 变量 
[1] 1 

attr (, "class") 
[1] "foo" 

> class (x) 

[1] "foo" 

» otype (x) 

[1] "s3" 


4 用 PFYT 包 的 otyPe 函 数 检查 X 的 类 型 


也 可 以 通过 structure () 函数 创建 S3 对 象 。 


> y «- structure (2, class = "foo") # 创建 S3 类 型 对 象 

>y 

[1] 2 # 查看 变量 

attr (, "class") 

[1] "foo" 

> class (y) # 查看 变量 类 型 

[1] "foo 

» otype (y) * 用 PLYT 包 的 otype 函 数 检查 Y 的 类 型 
[1] "s 


2. 创 建 一 个 多 类 型 的 S3 对 象 


S3 对 象 没有 明确 的 结构 关系 ， 一 个 33 对 象 可 以 有 多 个 类 型 。S3 对 象 类 型 ， 通 过 变量 的 class 属 性 来 定义 ，class 属 性 可 以 是 一 个 向 量 ， 所 以 允许 多 类 型 。 


> x«l + 定义 变量 


> attr (x, 'class') «- c ("foo", "bar") + 设置 多 个 S3 类 型 
> class (x) # 查看 变量 x 类 型 

[1] "foo" "bar" 

» otype (x) # 查看 变量 x 类 型 

[1] "$3" 


4.2.2” 泛 型 函数 和 方法 调用 


对 于 S3 对 象 的 使 用 ， 通 常用 UseMethod () 函数 来 定义 一 个 泛 型 函数 的 名 称 ， 通 过 传 入 参数 的 class 属 性 来 确定 不 同 的 方法 调用 。 下 面 我 们 创建 一 个 33 类 型 的 泛 型 函数 ， 定 义 一 个 名 为 teacher 的 泛 型 函 
于 S3 对 象 的 调用 。 


“ 用 UseMethod () 定义 teacher 泛 型 函 数 。 


"用 teacher.xxx 的 语法 格式 定义 teacher 对 象 的 行为 ， 其 中 teacher.default 是 默认 行为 。 


> teacher «- function (x, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) UseMethod ("teacher") # 用 UseMethod 
# 泛 型 函数 

> ftype (teacher) * 用 pryr 包 中 的 ftype () 函数 检查 teacher 的 类 型 

[1] "83" "generic" 

> teacher.lecture «- function (x) print ("讲课 ") # 定义 Leacher 内 部 函数 


> teacher.assignment «- function (x) print ("布置 作业 ") 
> teacher.correcting «- function (x) print ("批改 作业 ") 
> teacher.default«-function (x) print ("你 不 是 teacher") 4 定义 teacher 的 默认 行为 函数 


方法 调用 时 ， 通 过 传 入 参数 的 class 属 性 来 确定 不 同 的 方法 调用 。 


' 定义 一 个 变量 a， 并 设置 a 的 class 属 性 为 lecture。 


' 把 变量 a 传 入 teacher 泛 型 函数 中 。 


“ teacher.lecture () 函数 的 行为 被 调用 。 


> a«-'teacher' t 定义 一 个 变量 a 

> attr (a, 'class') «- 'lecture' 4 把 变量 a 的 值 设置 为 行为 
> teacher (a) # 执行 老师 的 行为 

[1] "讲课 " 


当然 ， 我 们 也 可 以 直接 调用 teacher 中 定义 的 行为 ， 如 果 这 样 做 就 失去 了 面向 对 象 封 装 的 意义 。 


> teacher.lecture () 

[1] "讲课 " 

> teacher.lecture (a) 

[1] "讲课 " 

> teacher () # 如 果 参 数 的 class 类 型 不 是 已 经 定义 的 ， 则 执行 默认 行为 函数 
[1] "你 不 是 teacher" 


对 比 其 他 语言 ， 这 里 R 的 泛 型 函数 就 表示 方法 接口 ，teacher.xxx 表 示 接 口 的 方法 实现 。 


4.2.3 ”查看 S3 对 象 的 函数 


当 我 们 使 用 S3 对 象 进行 面向 对 象 封 装 后 ， 可 以 用 methods () 函数 来 查看 33 对 象 中 定义 的 内 部 行为 函数 。 


> teacher 4 查看 teacher 对 象 

function (x, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) UseMethod ("teacher") 
» methods (teacher) # 查看 teacher 对 象 的 内 部 函数 

[1] teacher.assignment teacher.correcting teacher.default teacher. lecture 


通过 methods () 的 generic.function 参 数 来 匹配 泛 型 函数 名 字 。 


> methods (generic.function-predict) # 找到 环境 空间 中 以 predict 开 头 的 S3 类 型 的 函数 
[1] predict.ar* predict.Arima* predict.arima0* 
[4] predict.glm predict.HoltWinters* predict.lm 
[7] predict.loess* predict.mlm predict.nls* 
[10] predict.poly predict.ppr* predict.prcomp* 
[13] predict.princomp* predict.smooth.spline* predict.smooth.spline.fit* 


[16] predict.StructTS* 
Non-visible functions are asterisked 


通过 methods () 的 class 参 数 来 匹配 类 的 名 字 。 


> methods (class-lm) 4 找到 环境 空间 中 以 lm 为 class 属 性 的 S3 类 型 的 对 象 
[1] addl.lm* alias.lm* anova.lm case.names.lm* 
[5] confint.lm* cooks.distance.lm* deviance.lm* dfbeta.lm* 
[9] dfbetas.lm* dropl.lm* dummy.coef.lm* effects.lm* 
13] extractAIC.lm* family.lm* formula.lm* hatvalues.lm 
17] influence.lm* kappa.lm labels.lm* logLik.lm* 
21] model.frame.lm model.matrix.lm nobs.lm* plot.1m 
25] predict.lm print.lm proj.lm* qr.lm* 
29] residuals.lm rstandard.lm rstudent.lm simulate.lm* 
33] summary.lm variable.names.lm* vcov.lm* 


Non-visible functions are asterisked 


getAnywhere () 函数 查看 所 有 的 函数 。 


> getAnywhere (teacher.lecture) # S teacher.lecture () 函数 
A single object matching 'teacher.lecture' was found 
It was found in the following places 
.GlobalEnv 
registered S3 method for teacher 
with value 
function (x) print ("讲课 ") 
» predict.ppr * 查看 不 可 见 的 函数 Predict .ppr 
Error: object 'predict.ppr' not found 
» exists ("predict.ppr") 
[1] FALSE 
» getAnywhere ("predict.ppr") # getAnywhere () 函数 查找 Predict .PP 
A single object matching 'predict.ppr' was found 
It was found in the following places 
registered S3 method for predict from namespace stats 
namespace: stats 


with value 
function (object, newdata, 
{ 
if (missing (newdata) ) 
return (fitted (obje 


http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 


ct) ) 


if (! is.null (object$terms) ) ( 
newdata «- as.data.frame (newdata) 
rn <- row.names (newdata) 
Terms «- delete.response (object$terms) 
m «- model.frame (Terms, newdata, na.action - na.omit, 
xlev = object$xlevels) 
if (! is.null (cl <- attr (Terms, "dataClasses") ) ) 


.checkMFClasses 


(cl, m) 


keep «- match (row.names (m) , rn) 
x <- model.matrix (Terms, m, contrasts.arg = object$contrasts) 


} 


else { 


X <- as.matrix (newdata) 
keep <- seq len (nrow (x) ) 


rn «- dimnames (x) [ 


l 


Hn] 


if (ncol (x) ! = object$p) 


stop ("wrong number 


of columns in 'x'") 


res <- matrix (NA, length (keep) , object$q, dimnames = list (rn, 


object$ynames) ) 
res[keep, ] «- matrix ( 


.Fortran (C pppred, as.integer (nrow (x) ) , 


as.double (x) , as.double (object$smod) , y - double (nrow (x) * 
object$q) , double (2 * object$smod[4L]) ) $y, ncol = object$q) 


drop (res) 
} 


<bytecode: 0x000000000df6c2d0> 


<environment: namespace: sti 


ats> 


同样 ， 使 用 getS3method () 


函数 也 可 以 查看 不 可 见 的 函数 。 


> getS3method ("predict", ™ 
function (object, newdata, 

{ 
if (missing (newdata) ) 
return (fitted (obje 


ppr") 4 getS3method () 函数 查找 Predict.PPT 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 


ct) ) 


if (! is.null (object$terms) ) ( 
newdata «- as.data.frame (newdata) 
rn <- row.names (newdata) 
Terms «- delete.response (object$terms) 
m «- model.frame (Terms, newdata, na.action - na.omit, 
xlev = object$xlevels) 
if (! is.null (cl «- attr (Terms, "dataClasses") ) ) 


.checkMFClasses 


(cl, m) 


keep «- match (row.names (m) , rn) 
x <- model.matrix (Terms, m, contrasts.arg = object$contrasts) 


} 


else { 


X <- as.matrix (newdata) 
keep «- seq len (nrow (x) ) 


rn «- dimnames (x) [ 


} 


Hn] 


if (ncol (x) ! = object$p) 


stop ("wrong number 
res <- matrix (NA, lengi 

object$ynames) ) 
res[keep, ] «- matrix ( 


of columns in 'x'") 
th (keep) , object$q, dimnames - list (rn, 


.Fortran (C pppred, as.integer (nrow (x) ) , 


as.double (x) , as.double (object$smod) , y - double (nrow (x) * 
object$q) , double (2 * object$smod[4L]) ) $y, ncol = object$q) 


drop (res) 
} 


<bytecode: 0zx000000000df6c2d0> 


<environment: namespace: sti 


ats» 


4.2.4 ”5S3 对 象 的 继承 调用 方式 


53 对象 有 一 种 非常 简单 的 继承 调用 方式 ， 用 NextMethod () 函数 来 实现 。 下 面 定义 一 个 hode () 泛 型 函数 。 


> node <- function (x) UseMethod ("node", x) 

> node.default «- function (x) "Default node" 

» node.father «- function (x) c ("father") # father ät 

> node.son <- function (x) c ("son", NextMethod () ) # Son 函数 ， 通 过 NextMethod () 
* 函数 指向 father 函 数 

> nl «- structure (1, class = c ("father") ) # 定义 nl 

> node (n1) * 在 node 函 数 中 传 入 n1， 执 行 node.father () 函数 

[1] "father" 

» n2 «- structure (1, class - c ("son", "father") ) # 定义 n2， 设 置 class 属 性 为 两 个 

> node (n2) # 在 node 函 数 中 传 和 n2， 执 行 node.son () 函数 和 node.father () 函数 


[1] "son" "father" 


通过 对 node () 函数 传 入 n2 的 参数 ，node.son () 先 被 执行 ， 然 后 通过 NextMethod () 函数 继续 执行 node.father () 函数 。 其 实 这 样 就 模拟 了 子 函 数 调 有 


承 。 


4.2.5 ”S3 对 象 的 缺点 


从 上 面 对 S3 对 象 的 介绍 来 看 ，S3 对 象 并 不 是 完全 的 面向 对 象 实现 ， 而 是 一 种 通过 函数 调用 来 模拟 面向 对 象 实现 。 


“ S3 使 用 起 来 简单 ， 但 在 实际 的 面向 对 象 编程 过 程 中 ， 当 对 象 关系 有 一 定 的 复杂 度 时 ，S3 对 象 所 表达 的 意义 就 会 变 得 不 太 清 楚 。 


< S3 封 装 的 内 部 函数 可 绕 过 泛 型 函数 的 检查 直接 被 调用 。 


: S3 参 数 的 class 属 性 可 以 被 任意 


设置 ， 没 有 预 处 理 的 检查 。 


“ S3 参 数 只 能 通过 调用 class 届 性 进行 函数 调用 ， 其 他 属性 则 不 会 被 class () 函数 执行 。 


“ S3 参 数 的 class 属 性 有 多 个 值 时 ， 调 用 时 会 按照 程序 赋值 顺序 来 调用 第 一 个 合法 的 函数 。 


所 以 ，S3 只 是 R 语 言 面向 对 象 的 一 种 简单 实现 。 


4.2.6 ”S53 对 象 的 使 用 


53 对 象 系统 被 广泛 地 应 用 于 R 语 言 的 早期 开发 中 。 在 base 包 中 ， 就 有 很 多 的 S53 对 象 。 


查看 base 包 的 S3 对 象 。 


父 函数 的 过 程 ， 实 现 


回 


向 对 象 编程 中 的 继 


> mean # meant 


function (x, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 
UseMethod ("mean") 


Xbytecode:  0x3f8e0f0» 
«environment: namespace: base» 
» ftype (mean) 


[1] "53" "generic" 

» ftype (t) # thA 

[1] "83" "generic" 

» ftype (plot) * plotidk 

[1] "s3" "generic" 

自 定义 的 S3 对 象 。 

>a<-1 # 定义 数字 型 变量 a 

> class (a) # 变量 a 的 class 为 numeric 
[1] "numeric" 

> fl <- function (x) ( P 定义 泛 型 函数 f1 

+ asz 

+ UseMethod ("f1") 

+} 

> fl.numeric <- function (x) a # 定义 f1 的 内 部 函数 
> fl (a) # 给 f1 () 传 入 变量 a 

[3] 2 

> f1 (99) # f1 0 传 入 数字 99 

[1] 2 

» fl.character «- function (x) paste ("char", x) # 定义 f1 的 内 部 函数 
> £l ("a") # 给 £1 () 传 入 字符 a 

[1] "char a" 


通过 本 节 的 介绍 ， 我 们 对 S3 对 象 系统 有 了 一 个 全 面 认 识 ， 开 始 R 语 言 的 面向 对 象 编程 之 路 。 下 一 节 将 介绍 Ri 语言 的 S4 对 象 系统 。 


43 ”R 语 言 基于 S4 的 面向 对 象 编程 
间 题 


new 
setClass 


R 语 言 基 


继续 上 一 节 的 内 容 ， 本 节 将 介绍 R 语 言 基 于 S4 的 面向 对 象 编程 。S4 对 象 系统 具有 明显 的 结构 化 特征 ， 更 适合 面向 对 象 的 程序 设计 。Bioconductor 社 区 ， 以 S4 对 象 系统 作为 基础 架构 ， 只 接受 符合 S4 定 义 的 有 


包 。 


4.3.1 创建 54 对 象 


S4 对 象 系统 是 一 种 R 语 言 面 向 对 象 实现 方式 ，S4 对 象 有 明确 的 类 定义 、 参 数 定义 、 参 数 检 查 、 继 承 关 系 、 实 例 化 、 接 口 函数 、 实 现 函 数 等 面向 对 象 系统 的 特征 。 
本 节 的 系统 环境 是 : 


: Linux: Ubuntu Server 12.04.2 LTS 64bit 


- R: 3.1.1 x86. 64-pc-linux-gnu. (64-bit) 


为 了 方便 我 们 检查 对 象 的 类 型 ， 引 入 pryr 包 作为 辅助 工具 。 关 于 pryr 包 的 介绍 ， 请 参看 3.1 节 。 


~ + 启动 R 程 序 
> library (pryr) # 加 载 pryr 包 


1. 如 何 创建 54 对 象 ? 


S4 对 象 系统 有 专门 的 类 定义 函数 setClass () 和 类 的 实例 化 函数 new () ， 下 面 我 们 看 看 setClass () 和 new () 是 如 何 使 用 的 。 首 先 ， 查 看 setClass () 函数 的 定义 。 


setClass (Class, representation, prototype, contains=character () , validity, 


access, 


where, 


version, 


sealed, package, 


S3methods = FALSE, 


slots) 


各 参数 解释 如 下 : 

Class: 定义 类 名 。 

“ slots: 定义 属性 和 属性 类 型 。 

“ prototype: 定义 属性 的 默认 值 。 
“contains=character () : 定义 父 类 ， 继 承 关系 。 
.validity: 定义 属性 的 类 型 检查 。 

- where: 定义 存储 空间 。 

“sealed: 如 果 设置 TRUE ， 则 同名 类 不 能 被 再 次 定义 。 
- package: 定义 所 属 的 包 。 

: Sámethods: R3.0.0 以 后 不 建议 使 用 。 
:tepresentation: R3.0.0 以 后 不 建议 使 用 。 
access: R3.0.0 以 后 不 建议 使 用 。 

“version: R3.0.0 以 后 不 建议 使 用 。 


通过 setClass () 函数 我 们 就 可 以 创建 一 个 S54 类 型 的 对 象 结构 了 。 


+ 定义 一 个 S4 对 象 


> setClass ("Person", slots-list (name-"character", age-"numeric") ) 


2. 创 建 一 个 S4 对 象 实例 


通过 setClass () 函数 定义 好 类 的 结构 ， 再 通过 new () 函数 来 实例 化 类 对 象 。 


> father<-new ("Person", name-"F", age-44) + 实例 化 一 个 Person 对 象 
> father 4 查看 father 对 象 ， 有 两 个 属性 name 和 age 
An object of class "Person" 

Slot "name": 

[1] "E" 

Slot "age": 

[1] 44 

> class (father) # 查看 father 对 象 类 型 ， 为 Person 
[1] "Person" 

attr (, "package") 

[1] ".GlobalEnv" 

> otype (father) # 查看 father 对 象 为 S4 的 对 象 

[1] "S4" 


3. 创 建 一 个 有 继承 关系 的 S4 对 象 


如 果 需 要 创建 有 继承 关系 的 S4 对 象 ， 可 以 通过 setClass () 函数 的 contains 属 性 来 设置 父 类 。 


> setClass ("Person", slots-list (name-"character", age-"numeric") ) 
# 创建 一 个 S4 对 象 Person 
> setClass ("Son", slots-list (father-"Person", mother-"Person") , contains-"Person") 


* 创建 Person 的 子 类 


# 实例 化 一 个 Son 对 象 


> father<-new ("Person", name-"F", age-44) 4 实例 化 Person 对 象 
> mother<-new ("Person", name-"M", age-39) 

» son«-new ("Son", name-"S", age-16, father-father, mother-mother) 
> son8name * 查看 son 对 象 的 name 属 性 

i] "s" 

> son@age + 查看 son 对 象 的 age 属 性 

1] 16 


> son@father 
An object of class "Person" 
Slot "name": 


1] "p" 
Slot "age": 
1] 44 


» slot (son, "mother") 
An object of class "Person" 
Slot "name": 


» otype (son) 

1] "S4" 

> otype (son8name) 
1] "primitive" 

> otype (son(mother) 
1] "S4" 

> isS4 (son) 

1] TRUE 

> isS4 (sonename) 

1] FALSE 

> isS4 (son&mother) 
1] TRUE 


4 查看 son 对 象 的 father 属 性 


# 查看 son 对 象 的 mother 属 性 


# 检查 son 类 型 
# 检查 son@name 属 性 类 型 
# 检查 son@mother 属 性 类 型 
# 用 isS4 () 检查 S4 对 象 的 类 型 


4.54 对 象 的 默认 值 


我 们 定义 类 时 ， 类 一 般 都 会 包括 属性 字段 (sts) ， 通 过 setClass () 函数 的 prototype 属 性 给 属性 字段 中 定义 的 参数 设置 默认 值 。 


> setClass ("Person", slots-list (name-"character", age-"numeric") ) 

> a«-new ("Person", name-"a") # 属性 age 为 空 

>a 

An object of class "Person" 

Slot "name": 

[1] "a" 

Slot "age": 

numeric (0) 

> setClass ("Person", slots-list (name-"character", age-"numeric") , prototype = list (age = 20) ) 
4 设置 属性 age 的 默认 值 为 20 

> b«-new ("Person", + 属性 age 为 空 

> b # 属性 age 的 默认 值 是 20 

An object of class "Person" 

Slot "name": 

n] "b" 

Slot "age": 

[1] 20 


5.S4 对 象 的 类 型 检查 


通过 setValidity () 函数 给 属性 字段 中 定义 的 参数 设置 类 型 检查 。 


> setClass ("Person", slots-list (name-"character", age-"numeric") ) 
> bad«-new ("Person", name-"bad", age-"abc") # 传 入 错误 的 age 类 型 
Error in validObject (.Object) 
invalid class "Person" object: invalid object for slot "age" in class "Person": 


got class "character", should be or extend class "numeric" 
> setValidity ("Person", function (object) { 4 设置 age 的 非 负 检查 
十 if (object@age «- 0) stop ("Age is negative.") 
t 
Class "Person" [in ".GlobalEnv"] 
Slots: 
Name: name age 
Class: character numeric 
> bad2«-new ("Person", name-"bad", age--1) E 修正 传 入 小 于 0 的 年 龄 
Error in validityMethod (object) : Age is negative. 


6. 从 一 个 已 实例 化 的 对 象 中 创建 新 对 象 


S4 对 象 还 支持 从 一 个 已 实例 化 的 对 象 中 创建 新 对 象 ， 创 建 时 可 以 覆盖 对 象 的 值 。 


> setClass ("Person", slots-list (name-"character", age-"numeric") ) 

> nl«-new ("Person", name-"n1l", age-19) ; nl # 创建 一 个 对 象 实例 nl 

An object of class "Person" 

Slot "name": 

[1] "nl" 

Slot "age": 

[1] 19 

» n2«-initialize (nl, name-"n2") ; n2 # 从 实例 n1 中 创建 实例 n2， 并 修改 name 的 属性 值 
An object of class "Person" 

Slot "name": 


[1] "n2" 
Slot "age": 
[1] 19 


4.3.2 ”访问 S4 对 象 的 属性 


在 S3 对 象 中 ， 一 般 我 使 用 $ 来 访问 一 个 对 象 的 属性 。 但 在 S4 对 象 中 ， 我 们 只 能 使 用 @ 来 访问 一 个 对 象 的 属性 。 


> setClass ("Person", slots-list (name-"character", age-"numeric") ) 
> a«-new ("Person", name-"a") 


> agname # 访问 S4 对 象 的 属性 

[1] "a" 

» slot (a, "name") 

[1] "e" 

> a$name # 错误 的 属性 访问 

Error in a$name : $ operator not defined for this S4 class 
> a[l] 

Error in a[1] : object of type 'S4' is not subsettable 

> a[[1]] 

Error in a[[1]] : this S4 class is not subsettable 


4.3.3 ”S4 的 泛 型 函数 


S4 的 泛 型 函数 实现 有 别 于 S3 的 实现 ，S4 分 离 了 方法 的 定义 和 实现 ， 如 在 其 他 语言 中 我 们 常 说 的 接口 和 实现 分 离 。 通 过 setGeneric () 来 定义 接口 ， 通 过 setMethod () 来 定义 实现 类 ， 这 样 可 以 让 S4 
对 象 系统 更 符合 面向 对 象 的 特征 。 


普通 函数 的 定义 和 调用 。 


> work«-function (x) cat (x, "is working") 
» work ('Conan') 
Conan is working 


让 我 们 来 看 看 如 何 用 R 分 离 接 口 和 实现 。 


> setClass ("Person", slots-list (name-"character", age-"numeric") ) # 定义 Person 对 象 

> setGeneric ("work", function (object) standardGeneric ("work") ) # 定义 泛 型 函数 work， 即 接口 

> setMethod ("work", signature (object = "Person") , function (object) cat (object@name , 
"is working") ) # 定义 Work 的 实现 函数 ， 并 指定 参数 类 型 为 Person 对 象 

[1] "work" 

» a«-new ("Person", name-"Conan", age-16) 4 创建 一 个 Person 对 和 象 a 

> work (a) 4 Jest gatt worki žk 


Conan is working 


通过 S4 对 象 系统 ， 把 原来 的 函数 定义 及 调用 过 程 从 2 步 变 成 4 步 : (1) 定义 数据 对 象 类 型 ; (2) 定义 接口 图 数 ; (3) 定义 实现 函数 ; (4) 把 数据 对 象 以 参数 传 入 接口 函数 ， 执 行 实现 函数 。 所 以 ，S4 
对 象 系统 是 一 个 结构 化 的 面向 对 象 实现 。 


43.44 ”查看 $4 对 象 的 函数 


当 我 们 使 用 34 对 象 进 行 面 向 对 象 封装 后 ， 我 们 还 需要 能 查看 S4 对 象 的 定义 和 函数 定义 。 下 面 继续 使 用 前 面 Person 和 work 的 例子 中 定义 的 数据 对 象 。 


> ftype (work) # 检查 work 的 类 型 
[1] "s4" "generic" 
> work $oddESdworkddt 


standardGeneric for "work" defined from package ".GlobalEnv" 
function (object) 
standardGeneric ("work") 
«environment: 0x2aa6b18> 
Methods may be defined for arguments: object 
Use showMethods ("work") for currently available ones. 
» showMethods (work) # 查看 Work 函数 的 现实 定义 
Function: work (package .GlobalEnv) 
object-"Person" 
> getMethod ("work", "Person") # 查看 Person 对 象 的 work 函 数 现实 
Method Definition: 
function (object) 
cat (objectGname, "is working") 
Signatures: 
object 
target "Person" 
defined "Person" 
> selectMethod ("work", "Person") 
Method Definition: 
function (object) 
cat (objectGname, "is working") 
Signatures: 
object 
target "Person" 
defined "Person" 


> existsMethod ("work", "Person") 4 检查 Person 对 象 有 没有 work 函 教 
[1] TRUE 

> hasMethod ("work", "Person") 

[1] TRUE 


4.3.5”S4 对 象 的 使 用 


我 们 接 下 来 用 34 对 象 做 一 个 例子 ， 定 义 一 组 图 形 函 数 的 库 。 


1. 任 务 一 : 定义 | 


网 


形 库 的 数据 结构 和 计算 函数 


假设 最 底层 以 Shape 图 形 为 基 类 ， 包 括 圆 形 和 椭圆 形 ， 并 计算 出 它们 的 面积 和 周 长 。 


“ 定义 图 形 库 的 数据 结构 


“ 定义 圆 形 的 数据 结构 ， 并 计算 面积 和 周 长 


“ 定义 椭圆 形 的 数据 结构 ， 并 计算 面积 和 周 长 


结构 如 图 4-4 所 示 。 


Ellipse 


area () 
'circum() 


*circum() 


图 4-4 任务 一 : 图 形 库 的 数据 结构 


我 们 首先 定义 基 类 Shape 和 圆 形 类 (Circle) 。 


> setClass ("Shape", slots-list (name-"character") ) # 定义 基 类 Shape 

> setClass ("Circle", # 定义 圆 形 类 Circle， 继 承 Shape， 属 性 radius 默 认 值 为 1 

+  contains-"Shape", 

+  slots-list (radius-"numeric") , 

+  prototype-list (radius = 1) ) 

> setValidity ("Circle", function (object) ( # 验证 radius 属 性 值 要 大 等 于 0， 当 小 于 等 于 


# 0 时 就 退出 


十 if (objectGradius <= 0) stop ("Radius is negative.") 

+ }) 

Class "Circle" [in ".GlobalEnv"] 

Slots: 

Name: radius name 

Class: numeric character 

Extends: "Shape" 

> cl«-new ("Circle", name-"cl") 4 创建 两 个 圆 形 实例 


> c2«-new ("Circle", name-"c2", radius-5) 


第 二 步 ， 定 义 计 算 面积 的 接口 函数 和 实现 函数 。 


> setGeneric ("area", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) standardGeneric ("area") ) 
# 计算 面积 泛 型 函数 接口 

[1] "area" 

> setMethod ("area", "Circle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) ( # 计算 面积 的 函数 现 

十 print ("Area Circle Method") 

* pi*obj8radius^2 

+H 

[1] "area" 

> area (c1) # 分 别 计算 cl 和 c2 两 个 圆 形 的 面积 

[1] "Area Circle Method" 

[1] 3.141593 

> area (c2) 

[1] "Area Circle Method" 

[1] 78.53982 


第 三 步 ， 定 义 计算 周 长 的 接口 和 实现 。 


> setGeneric ("circum", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 


* 计算 周 长 泛 型 函数 接口 


standardGeneric ("circum") ) 


[1] "circum" 

> setMethod ("circum", "Circle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( # 计算 周 长 的 函数 
* 2*pi*obj8radius 

+9) 

[1] "circum" # 分 别 计算 cl 和 c2 两 个 国 形 的 周 长 

> circum (c1) 

[1] 6.283185 

> circum (c2) 

[1] 31.41593 


~ 


在 上 面 的 代码 中 ， 我 们 实现 了 圆 形 的 定义 ， 下 面 我 们 实现 椭圆 形 。 


# 定义 椭圆 形 的 类 ， 继 承 Shape，Tradius 参 数 默 认 值 为 Cc (1, 1) ， 分 别 表示 椭圆 形 的 长 半径 和 短 半径 
> setClass ("Ellipse", 


slots=list (radius-"numeric") , 

prototype-list (radius-c (1, 1) ) ) 

setValidity ("Ellipse", function (object) { # 验证 radius 参 数 

if (length (objectéradius) ! = 2) stop ("It's not Ellipse.") 

if (length (which (objectGradius«-0) ) »0) stop ("Radius is negative.") 


十 十 十 V+ 十 十 


) 
Class "Ellipse" [in ".GlobalEnv"] 
Slots: 
Name: radius name 
Class: numeric character 
Extends: "Shape" 


> el«-new ("Ellipse", "el") + 创建 两 个 椭圆 形 实例 el 和 e2 


> e2<-new ("Ellipse", e2", radius=c (5, 1) ) 

> setMethod ("area", "Ellipse", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) { # 计算 椭圆 形 面积 
+ print ("Area Ellipse Method") Bi 
+ pi * prod (obj@radius) 

+3) 

[1] "area" 

> area (e1) # 计算 e1 和 e2 两 个 椭圆 形 的 面积 

[1] "Area Ellipse Method" 

[1] 3.141593 

> area (e2) 

[1] "Area Ellipse Method" 

[1] 15.70796 


计算 椭圆 形 周 长 的 函数 实现 。 椭 圆 形 的 周 长 是 一 种 近似 计算 ， 请 不 要 纠结 于 这 个 计算 公式 。 


> setMethod ("circum", "Ellipse", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) ( + 计算 椭圆 形 周 
十 cat ("Ellipse Circum : Mn") 

+ 2*pi*sqrt ( (obj@radius[1]^2+obj@radius[2]^2) /2) 

+3) 

[1] "circum" 

> circum (e1) # 计算 e1 和 e2 两 个 顶 圆 形 的 周 长 

Ellipse Circum : 

[ 


1] 6.283185 
» circum (e2) 
Ellipse Circum : 
[1] 22.65435 


我 们 已 经 完成 了 圆 形 和 椭圆 形 的 数据 结构 定义 ， 以 及 计算 面积 和 周 长 的 方法 实现 。 不 知 大 家 有 没有 发 现 ， 圆 形 是 椭圆 形 的 一 个 特例 呢 ? 


2. 任 务 二 : 重 构 圆 形 和 椭圆 形 的 设计 


当 椭圆 形 的 长 半径 和 短 半径 相等 时 ， 即 radius 的 两 个 值 相等 ， 形 成 的 图 形 为 圆 形 。 利 用 这 个 特点 ， 我 们 就 可 以 重新 设计 圆 形 和 椭圆 形 的 关系 。 椭 圆 形 是 圆 形 的 父 类 ， 而 圆 形 是 椭圆 形 的 子 类 。 结 构 如 图 


4-5 所 示 。 
> setClass ("Shape", # X XShape 
*  slots-list (name-"character") ) 
> setClass ("Ellipse", # Ellipse 继 承 Shape 
+ contains-"Shape", 
* slots-list (radius-"numeric") , 
+  prototype-list (radius-c (1, 1) ) ) 
> setClass ("Circle", # Circle 继 承 Ellipse 
* contains-"Ellipse", 
* slots-list (radius-"numeric") , 
+  prototype-list (radius = 1) ) 
> setGeneric ("area", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) standardGeneric ("area") ) d 
1] "area" 


> setMethod ("area", "Ellipse", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( 
十 cat ("Ellipse Area : Mn") 
* pi * prod (obj@radius) 


# X Xareaí 


> setMethod ("area", "Circle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) { 
* cat ("Circle Area : Mn") 

* pi*obj8radius^2 

+I) 

1] "area" 

> setGeneric ("circum", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/...) standardGeneric ("circum") ) 
1] "circum" 

> setMethod ("circum", "Ellipse", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( 
十 cat ("Ellipse Circum : Mn") 

* 2*pi*sqrt ( (obj&radius[1]^2*0bjGradius[2]^2) /2) 

tp 
1] "circum" 

> setMethod ("circum", "Circle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( 
+ cat ("Circle Circum : \n") 

+ 2*pi*obj@radius 

+} 
1] "circum" 

> el«-new ("Ellipse", name 
» cl«-new ("Circle", name-"c 
> area (el) 

Ellipse Area : 

1] 31.41593 

» circum (el) 

Ellipse Circum : 

1] 23.92566 


# 定义 area 的 


# 定义 circum 的 


# 定义 circum 的 C 


+ 创建 实例 
# 计算 椭圆 形 的 面积 和 周 长 


", radius-c (2, 5) ) 
, radius-2) 


> area (c1) # 计算 圆 形 的 面积 和 周 长 
Circle Area : 

[1] 12.56637 

> circum (cl) 

Circle Circum : 

[1] 12.56637 


我 们 重 构 后 的 结构 是 不 是 更 合理 呢 ! 


3. 任 务 三 : 增加 矩形 的 图 形 处 理 


我 们 的 图 形 库 需 要 进一步 扩充 ， 加 入 矩形 和 正方 形 。 
“ 定义 矩形 的 数据 结构 ， 并 计算 面积 和 周 长 。 
“定义 正方 形 的 数据 结构 ， 并 计算 面积 和 周 长 。 


:正方形 是 矩形 的 特例 ， 定 义 算 形 是 正方 形 的 父 类 ， 而 正方 形 是 矩形 的 子 类 。 


结构 如 图 4-6 所 示 。 


«&interface?» 


; *circum() 
Circle m 


图 4-5 任务 二 : 重 构 椭 圆 形 的 数据 结构 
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图 4-6 ”任务 三 : 矩形 的 数据 结构 


setClass ("Rectangle", 4 定义 矩形 Rectangle， 继 承 Shape 
contains-"Shape", 
slots-list (edges-"numeric") , 
prototype-list (edges-c (1, 1) ) ) 
setClass (" 
contains- 
slots-list (edges-"numeric") , 
prototype-list (edges-1) ) 
setMethod ("area", "Rectangle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) {# 定义 area 的 Rectang 
cat ("Rectangle Area : Mn") z 
prod (obj@edges) 


# 定义 正方 形 Square， 继 承 Rectangle 


p 
1] "area" 
setMethod ("area", "Square", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( # 定义 area 的 Squar 
cat ("Square Area : \n") 
objGedges^2 
p 
1] "area" 
setMethod ("circum", "Rectangle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( # 定义 circur 


cat ("Rectangle Circum : Mn") 
2*sum (objGedges) 
p 
1] "circum" 
setMethod ("circum", "Square", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( # 定义 circum 的 S 
cat ("Square Circum : M") 
4*objGedges 


-F-VOTLF-VGL-F-VGOtHH-VETTLVOEGAEV 


4 
1] "circum" 

> rl«-new ("Rectangl ame="r1", edges=c (2, 5) ) # 创建 实例 

> sl<-new ("Squar ="51", edges-2 

» area (rl) # HREH 60 BUR 
Rectangle Area : 

1] 10 

> area (s1) 

Square Area 

1] 4 

> circum (r1) # 计算 正方 形 的 面积 和 周 长 
Rectan le Circum 

1] 14 

> circum (s1) 

Square Circum 

1] 8 

我 们 的 图 形 库 已 经 支持 4 种 图 形 了 ! 用 面向 对 象 的 结构 来 设计 ， 是 不 是 结构 化 思路 很 清晰 呢 ! 

4. 任 务 四 : 在 基 类 Shape 中 增加 shape 属 性 和 getShape 方 法 

接 下 来 ， 要 对 图 形 库 的 所 有 图 形 增加 一 个 图 形 类 型 的 变量 shape， 然 后 再 提供 一 个 getShape 函 数 可 以 检查 实例 中 的 是 shape 变 量 。 结 构 如 图 4-7 所 示 。 


areal) 
+circum!() 


area() 
circum() 


area () 
kcircum() 


+get Shape O 
J*area () 
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图 4-7 任务 四 : 完成 图 形 库 的 数据 结构 


如 果 这 个 需求 没有 面向 对 象 的 结构 ， 那 么 需要 在 所 有 图 形 定义 的 代码 中 都 增加 一 个 参数 和 一 个 判断 ， 如 果 有 100 个 图 形 ， 改 起 来 还 是 挺 复 杂 的 。 而 面向 对 象 的 程序 设计 就 非常 容易 解决 这 个 需求 ， 只 需 
要 在 基 类 上 改动 代码 就 可 以 实现 了 。 


> setClass ("Shape", # 重新 定义 基 类 Shape， 增 加 shape 属 性 

十 slots-list (name-"character", shape-"character") ) 

» setGeneric ("getShape", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) standardGeneric ("getShape 
4 定义 getShape 接 口 ba 


[1] "getShape" 

> Sethethod ( "getShape", "Shape", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( 4 定义 getShape 
十 cat (obj@shape, "\n") 

3 | 

[1] "getShape" 


网 


其 实 ， 这 样 改动 一 个 就 可 以 ， 我 们 只 需要 重新 实例 化 每 个 


形 的 对 象 就 行 。 如 果 我 们 再 多 做 一 步 ， 可 以 修改 每 个 对 象 的 定义 ， 增 加 shape 属 性 的 默认 值 。 


> setClass ("Ellipse", contains-"Shape", slots-list (radius-"numeric") , prototype-list 
(radius-c (1, 1) , shape-"Ellipse") ) 

> setClass ("Circle", contains-"Ellipse", slots-list (radius-"numeric") , prototype-list 
(radius = 1, shape-"Circle") ) 

> setClass ("Rectangle", contains-"Shape", slots-list (edges-"numeric") , prototype-list 
(edges-c (1, 1) , shape-"Rectangle") ) 

> setClass ("Square", contains-"Rectangle", slots-list (edges-"numeric") , prototype-list 


(edges=1, shape-"Square") ) 
> sl«-new ("Square", name-"sl", edges-2, shape-"Square") # 实例 化 一 个 Square 对 象 ， 并 
# 给 shape 必 性 赋值 
> getShape (s1) * 调用 基 类 的 getShape () 函数 


Square 


是 不 是 很 容易 呢 只 在 代码 对 应 的 地 方 进行 修改 ， 所 有 的 图 形 就 有 了 对 应 的 属性 和 方法 。 下 面 是 完整 的 R 语 言 代码 实现 : 


setClass ("Shape", slots-list (name-"character", shape-"character") ) 
setClass ("Ellipse", contains-"Shape", slots-list (radius-"numeric") , prototype-list 
(radius-c (1, 1) , shape-"Ellipse") ) 
setClass ("Circle", contains-"Ellipse", slots-list (radius-"numeric") , prototype-list 
(radius = 1, shape-"Circle") ) 
setClass ("Rectangle", contains-"Shape", slots-list (edges-"numeric") , prototype-list 
(edges-c (1, 1) , shape-"Rectangle") ) 
setClass ("Square", contains-"Rectangle", slots-list (edges-"numeric") , prototype-list 
(edges-1, shape-"Square") ) 
setGeneric ("getShape", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) standardGeneric ("getShape") 
setMethod ("getShape", "Shape", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( 
je (obj@shape, "Nn 
} 
setGeneric ("area", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) standardGeneric ("area") ) 
setMethod ("area", "Ellipse", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/...) ( 
cat ("Ellipse Area : Mn") 
pi * prod (obj@radius) 
p 


setMethod ("area", "Circle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) { 
cat ("Circle Area : Mn") 
pi*obj8radius^2 


p 

setMethod ("area", "Rectangle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( 
cat ("Rectangle Area : M") 一 

prod (obj@edges) 

li 

setMethod ("area", "Square", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) ( 
cat ("Square Area : M") B 
objGedges^2 

p 

setGeneric ("circum", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) standardGeneric ("circum") ) 

setMethod ("circum", "Ellipse", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) ( 
cat ("Ellipse Circum : Mn") 7 

j^ PPS. ( (obj8éradius[1]^2*0bj8radius[2]^2) /2) 

} 

setMethod ("circum", "Circle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) ( 
cat ("Circle Circum : Mn") m 

; 2*pi*obj8radius 

} 

setMethod ("circum", "Rectangle", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) ( 
cat ("Rectangle Circum : Mn") 
2*sum (objQ@edges) 

p 

setMethod ("circum", "Square", function (obj, http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/...) ( 
cat ("Square Circum : Mn") T 
4*obj@edges 

p 

el«-new ("Ellipse", name-"el", radius-c (2, 5) ) 

cl«-new ("Circle", name="c1", radius-2) 

rl«-new ("Rectangle", name-"rl", edges-c (2, 5) ) 

sl«-new ("Square", name-"s1l", edges-2) 

area (el) 

area (cl) 

circum (el) 

circum (cl) 

area (r1) 

area (s1) 

circum (rl) 

circum (sl) 


通过 这 个 例子 ， 我 们 全 面 地 了 解 了 R 语 言 中 S4 对 象 系统 的 面向 对 象 程序 设计 ， 有 没有 找到 相通 的 感觉 呢 ” 在 程序 员 的 世界 里 ， 世 间 万 物 都 可 以 抽象 成 对 象 。 


44 ”Ri 语言 基于 RC 的 面向 对 象 编程 
问题 


如 何 基 于 RC 面向 对 象 系统 编程 ? 


g bje ct 


Orte ntec 


Progr amming 


R 语 言 基于 RC 的 面向 对 象 编程 


http://blog.fens.me/r-class-rc/ 


继续 上 一 节 的 内 容 ， 本 节 将 介绍 RR 语言 基于 RC 的 面向 对 象 编程 。 RC 对象 系 统 从 底层 上 改变 了 原 有 S3 和 S4 对 象 系统 的 设计 ， 去 掉 了 泛 型 函数 ， 真 正 地 以 类 为 基础 实现 面向 对 象 的 特征 。 


RC 是 Reference classes 的 简称 ， 又 被 称 为 R5， 在 R 语 言 的 2.12 版 本 被 引入 ， 是 R 语 言 最 新 一 代 的 面向 对 象 系 统 。RC 不 同 于 原来 的 53 和 S4 对 象 系统 ，RC 对 象 系统 的 方法 是 在 类 中 自 定 的 ， 而 不 是 泛 型 
数 。RC 对 象 的 行为 更 类 似 于 其 他 的 编程 语言 ， 实 例 化 对 象 的 语法 也 有 所 改变 。 但 由 于 RC 对 象 系统 还 是 依赖 于 S4 对 象 系统 ， 我 们 可 以 简单 地 理解 为 RC 是 对 S4 的 更 进一步 的 面向 对 象 封装 。 从 面向 对 象 的 角度 
来 说， 我 们 下 面 要 重 定义 几 个 名 词 。 


[sl 


“类: 面向 对 象 系统 的 基本 类 型 ， 类 是 静态 结构 定义 。 


“对象: 类 实例 化 后 ， 在 内 存 中 生成 结构 体 。 


“方法: 是 类 中 的 函数 定义 ， 不 通过 泛 型 函数 实现 。 


本 节 的 系统 环境 是 : 
: Linux: Ubuntu Server 12.04.2 LTS 64bit 


“ R: 3.1.1 x86. 64-pc-linux-gnu. (64-bit) 


为 了 方便 我 们 检查 对 象 的 类 型 ， 引 入 pryr 包 作为 辅助 工具 。 关 于 pryr 包 的 介绍 ， 请 参看 3.1 节 。 


~R # 启动 R 程 序 
> library (pryr) # 加 载 pryr 包 


RC 对 象 系统 以 类 为 基本 类 型 ， 有 专门 的 类 的 定义 函数 setRefClass () 和 实例 化 对 象 的 生成 方法 ， 下 面 我 们 介绍 如 何 用 RC 对 象 系统 创建 一 个 类 。 


查看 RC 的 类 创建 函数 setRefClass () 函数 的 定义 。 


setRefClass (Class, fields = , contains = , methods =, where =, http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) 


各 参数 解释 如 下 : 


， Class: 定义 类 名 


' fields: 定义 属性 和 属性 类 型 


'contans: 定义 父 类 ， 继 承 关 系 
: methods: 定义 类 中 的 方法 
- where: 定义 存储 空间 


从 setRefClass () 函数 的 定义 来 看 ， 其 参数 比 S4 的 setClass () 函数 的 参数 少 。 


2. 创 建 RC 类 和 实例 
> User<-setRefClass ("User", fields-list (name-"character") ) # 定义 一 个 RC 类 
> User # 查看 User 的 定义 


Generator for class "User": 

Class fields: 

Name: name 

Class: character 

Class Methods: 

"callSuper", "copy", "export", "field", "getClass", 
"getRefClass", "import", "initFields", "show", "trace", 
"untrace", "usingMethods" 

Reference Superclasses: 

"envRefClass" 


下 面 我 们 实例 化 一 个 RC 对 象 。 


> ul«-User$new (name="u1") # 实例 化 一 个 User 对 象 ul 
> ul # 查看 Ul 对 和 象 
Reference class object of class "User" 

Field "name": 

1] "ul" 
> class (User) # 检查 User 类 的 类 型 
1] "refObjectGenerator" 
attr (, "package") 
1] "methods" 
» is.object (User) 
1] TRUE 
» otype (User) 

1] "Rc" 
> class (ul) + 检查 U1 的 类 型 
1] "User" 
attr (, "package") 
1] ".GlobalEnv" 
» is.object (ul) 
TRUE 
» otype (ul) 

1] "Rc" 


m 


3. 创 建 一 个 有 继承 关系 的 RC 


> User<-setRefClass ("User", 
+ fields=list (name-"character") ) # 创建 RC 类 User 
> Member<-setRefClass ("Member", # 创建 User 的 子 类 Member 
+ contains-"User", 
+  fields-list (manager-"User") ) 
> manager«-User$new (name-"manager") # 实例 化 User 
> member«-Member$new (name-"member", manager-manager) 4 实例 化 一 个 Son 对 象 
> member 4 查看 member 对 象 
Reference class object of class "Member" 
Field "name": 
1] "member" 
Field "manager": 
Reference class object of class "User" 
Field "name": 
1] "manager" 
» member$name 4 查看 member 对 象 的 name 属 性 
1] "member 
» member$manager 4 查看 member 对 象 的 manager 属 性 
Reference class object of class "User" 
Field "name": 
1] "manager" 
> otype (member$name) # 检查 对 象 的 属性 类 型 
1] "primitive" 
» otype (member$manager) 
1] "RC" 


4.RC 对 象 的 默认 值 


RC 的 类 有 一 个 指定 构造 器 方法 $initialize () ， 这 个 构造 器 方法 在 实例 化 对 象 时 ， 会 自动 被 运行 一 次 ， 通 过 这 个 构造 方法 可 以 设置 属性 的 默认 值 。 


# 定义 一 个 RC 类 

> User<-setRefClass ("User", 

* fields-list (name-"character", level-'numeric') , # 定义 2 个 属性 
+ methods-list ( 

十 initialize = function (name, level) { # 构造 方法 
+ print ("User: : initialize") 

+ name <<- 'conan' # 给 属性 增加 默认 值 

* level ««- 1 

本 } 

+ ) 

t) 

» ul«-User$new () # 实例 化 对 象 ul 

[1] "User: : initialize" 

> ul + 查看 对 象 U1， 属 性 被 增加 了 默认 值 


Reference class object of class "User" 
Field "name": 

[1] "conan" 

Field "level": 

1] 1 


4.4.3 ”对 象 赋值 


> User<-setRefClass ("User", # 定义 User 类 

+ fields=list (name-"character", age-"numeric", gender-"factor") ) 

> genderFactor«-factor (c ('F', 'M') ) # 定义 一 个 factor 类 型 

> ul«-User$new (name-"ul", age-44, gender=genderFactor[1]) # 实例 化 ul 
> ul$age 4 查看 age 属 性 值 

[1] 44 

给 u1 的 age 属 性 赋值 。 

> ul$age<-10 # 重新 赋值 

> ul$age 4 age 属性 改变 


[1] 10 


把 u1 对 象 赋值 给 u2 对 象 。 


> u2«-ul # 把 ul 赋值 给 U2 对象 

> u2$age # 查看 U2 的 age 属 性 

[1] 10 

> ul$age<-20 + 重新 赋值 

> ul$age # 查看 1，u2 的 age 属性 ， 都 发 生 改 变 
[1] 20 

> u2$age 

[1] 20 


由 于 把 u1 赋 值 给 u2 的 时 候 ， 传 递 的 是 u1 的 实例 化 对 象 的 引 


， 而 不 是 值 本 身 ， 所 以 


属性 发 生 改变 。 这 一 点 与 其 他 语言 中 对 象 赋值 是 一 样 的 。 如 果 想 进行 赋值 而 不 是 引 


传递 ， 可 以 


下 面 的 方法 实现 。 


> u3«-ul$copy () # 调用 ul 的 内 置 方法 copy O ， 赋 值 给 u3 


> u3$age # 查看 U3 的 age 属性 

[1] 20 

> ul$age«-30 # 重新 赋值 

> ul$age # 查看 U1 的 age 属性 ， 发 生 改 变 

[1] 30 

» u3$age # 查看 u3 的 age 属性 ， 没 有 改变 

[1] 20 

掌握 好 对 象 的 引用 关系 ， 不 仅 可 以 减少 值 传递 过 程 中 的 内 存 复制 过 程 ， 而 且 还 让 我 们 的 程序 运行 效率 更 高 。 


444 定义 对 象 的 方法 


在 33 和 34 对 象 系统 中 ， 我 们 实现 对 象 的 行为 时 ， 都 是 借助 于 泛 型 函数 来 实现 的 。 
。 而 在 RC 对 象 系统 中 ， 方 法 可 以 定义 在 类 的 内 部 ， 通 过 实例 化 的 对 象 完成 方法 调用 。 


这 种 实现 方法 的 最 大 问题 是 ， 在 定义 时 函数 和 对 象 的 代码 是 分 离 的 ， 需 要 在 运行 时 ， 


通过 判断 对 象 的 类 型 完成 方法 调 


> User«-setRefClass ("User", # 定义 一 个 RC 类 ， 包 括 方法 
+ fields=list (name="character", favorite="vector") , 

+ methods = list ( # 方法 属性 

本 addFavorite = function (x) ( # 增加 一 个 兴趣 

十 favorite ««- c (favorite, x) 

* 

* delFavorite = function (x) { # 删除 一 个 兴趣 

十 favorite ««- favorite[-which (favorite == x) ] 
十 > 

+ setFavorite = function (x) { # 重新 定义 兴趣 列表 
* favorite ««- x 

* } 

* ) 

+3 

> ul«-User$new (name-"ul", favorite=c ('movie', 'football') ) 


zul + 查看 U1 对 象 
Reference class object of class "User" 
Field "name": 


n] "ul" 
Field "favorite": 
[1] "movie" "football" 


+ 实例 化 对 象 ul 


接 下 来 ， 进 行 方法 操作 。 


> ul$delFavorite ('football') 
» ul$favorite 

[1] "movie" 

> ul$addFavorite ('shopping') 
» ul$favorite 

[1] "movie" "shopping" 

» ul$setFavorite ('reading') 
» ul$favorite 

[1] "reading" 


# 删除 一 个 兴趣 
# 查看 兴趣 属性 


# 增加 一 个 兴趣 


+ 重 置 兴趣 列表 


直接 把 方法 定义 到 类 的 内 部 ， 通 过 实例 化 的 对 象 进行 访问 ， 这 样 就 做 到 了 ， 在 定义 时 就 能 保证 方法 的 作 


445 ”RC 对 象 内 置 方法 和 内 置 | 


Hl 


性 


对 于 RC 的 实例 化 对 象 ， 除 了 我 们 自己 定义 的 方法 ， 还 有 几 个 内 置 的 方法 。 之 前 
1. 内 置 方法 


RC 对 象 有 以 下 13 个 内 置 方 法 。 


域 ， 减 少 运行 时 检查 的 系统 开销 。 


属性 复制 赋值 时 使 用 的 copy () 方法 ， 就 是 其 中 之 一 。 


` initialize， 类 的 初始 化 函数 ， 用 于 设置 属性 的 默认 值 ， 只 能 在 类 定义 的 方法 中 使 用 。 


“callSuper， 调 用 父 类 的 同名 方法 ， 只 能 在 类 定义 的 方法 中 使 用 。 
“ copy， 复 制 实例 化 对 象 的 所 有 属性 。 

initFields ， 给 对 象 的 属性 赋值 。 

“ field， 查 看 属性 或 给 属性 赋值 。 

:BetClass， 查 看 对 象 的 类 定义 。 

- getRefClass ， 同 getClass。 

“ show， 查 看 当前 对 象 。 

“ export， 查 看 属性 值 ， 以 类 为 作用 域 。 

< import， 把 一 个 对 象 的 属性 值 赋值 给 另 一 个 对 象 。 

“ trace， 跟 踪 对 象 中 方法 调用 ， 用 于 程序 debug。 


: untrace， 取 消 跟 踪 。 


< usingMethods, ， 用 于 实现 方法 调用 ， 只 能 在 类 定义 的 方法 中 使 用 。 这 个 方法 不 利于 程序 的 健壮 性 ， 所 以 不 建议 使 用 。 


接 下 来 ， 我 们 使 


这 些 内 置 的 方法 。 首 先 定义 一 个 父 类 User， 包 括 name 和 leve| 两 个 


属性 ，addLevel 和 addHighLevel 两 个 功能 方法 ，initialize 构 造 方法 。 


User«-setRefClass ("User", 4 类 User 
fields-list (name-"character", level-'numeric') , 
methods-list ( 


initialize = function (name, level) ( 
print ("User: : initialize") 
name ««- 'conan' 


level ««- 1 
h 
addLevel = function (x) { 

print ('User: : addLevel') 

level <<- level+x 
fi 
addHighLevel = function () { 
print ('User: : addHighLevel') 
addLevel (2) 
} 
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定义 子 类 Member， 继 承 父 类 User， 并 包括 同名 方法 addLevel 覆 盖 父 类 的 方法 ， 在 addLeve| 方 法 中 ,会 调 


父 类 的 同名 方法 。 


> Member«-setRefClass ("Member", contains-"User", # F XMember 
+ fields-list (age-'numeric') , + 子 类 中 的 属性 

+ methods-list ( 

+ addLevel = function (x) { # 履 盖 父 类 的 同名 方法 
* print ('Member: : addLevel') 

十 callSuper (x) # 调用 父 类 的 同名 方法 

* level <<- level+1 

+ ) 

* ) 

+) 

分 别 实例 化 对 象 u1 和 m1。 

> ul«-User$new (name-'ul', level-10) 4 实例 化 ul 

1] "User: : initialize" 

> ul # 查看 1 对 象 ，Snew () 不 能 实现 赋值 的 操作 


Reference class object of class "User" 
Field "name": 


1] "conan" 
Field "level": 
di] uh 


> ul$initFields (name-'ul', level-10) 
Reference class object of class "User" 
Field "name": 

1] "ul" 

Field "level": 

1] 10 

» mi«-Member$new () 

1] "User: : initialize" 
> ml$initFields (name-'ml', level-100, age-12) 
Reference class object of class "Member" 
Field "name": 

1] "ml" 

Field "level": 

1] 100 

Field "age": 

1] 12 


+ 实例 化 ml 


# 通过 $initFields () 向 属性 赋值 


执行 $copy ( 方法 ， 复 制 对 象 属性 并 传 值 。 

> u2«-ul$copy () # 属性 复制 到 u2 

1] "User: : initialize" 

> ul$addLevel (1) ; ul 4 执行 方法 addLevel () ， 让 leve1 加 1，ul 已 改变 
1] "User: : addLevel" 


Reference class object of class "User" 

Field "name": 

1] "ul" 

Field "level": 

1] 11 

> u2 # QU2 的 level 与 UL 没有 引用 关系 ，u2 没 有 变化 
Reference class object of class "User" 

Field "name": 


1] "u" 
Field "level": 

1] 10 

使 用 方法 field () ， 查 看 并 给 level 属 性 赋值 。 

> ul$field ('level') + 查看 level 属 性 值 
[1] 11 

» ul$field ('level', 1) # 给 level 赋 值 为 1 
> ul$level # 查看 level 属 性 值 
[1] 1 


使 用 getRefClass () 和 getClass () 方法 查看 u1 对 象 的 类 定义 。 


> ml$getRefClass () # 类 引用 的 定义 

Generator for class "Member": 

Class fields: 

Name: name level age 

Class: character numeric | numeric 

Class Methods: 

"addHighLevel", "addLevel", "addLevel#User", "callSuper", "copy", "export", 

"field", "getClass", "getRefClass", "import", "initFields", 

"initialize", "show", "trace", "untrace", "usingMethods" 

Reference Superclasses: 

"User", "envRefClass" 

> mi$getClass () $ 类 定义 

Reference Class "Member": 

Class fields: 

Name: name level age 

Class: character numeric | numeric 

Class Methods: 

"addHighLevel", "addLevel", "addLevel#User", "callSuper", "copy", "export", 
"field", "getClass", "getRefClass", "import", "initFields", 

"initialize", "show", "trace", "untrace", "usingMethods" 

Reference Superclasses: 

"User", "envRefClass" 

> otype (mlSgetRefClass () ) # 通过 otype 查 看 类 型 的 不 同 

[1] "Rc" 


> otype (ml$getClass () ) 
[1] "54" 


使 用 $show () 方法 查看 对 象 属性 值 ， 同 show () 函数 一 样 ， 对 象 直接 输出 时 就 是 调用 了 $show () 方法 。 


> mi$show () 
Reference class object of class "Member" 
Field "name": 

1] "mi" 
Field "level": 
1] 100 
Field "age": 
1] 12 
» show (ml) 
Reference class object of class "Member" 
Field "name": 
1] "mi" 
Field "level": 
1] 100 
Field "age": 
1] 12 
> ml 
Reference class object of class "Member" 
Field "name": 

1] "ml" 
Field "level": 

1] 100 
Field "age": 
1] 12 


使 用 $trace () 跟踪 方法 调用 ， 再 用 $untrace () 方法 取消 跟踪 绑 定 。 


> ml$trace ("addLevel") # 对 addLevel () 方法 跟踪 

Tracing reference method "addLevel" for object from class "Member" 

1] "addLevel" 

> mi$addLevel (1) 4 34 addLevel () Zik, Tracing ml$addLevel (1) 被 打印 ， 跟 踪 生 效 


Tracing ml$addLevel (1) on entry 

1] "Member: : addLevel" 

1] "User: : addLlevel" 

> ml$addHighLevel () 4 调用 父 类 的 addHighLevel () Zik, Tracing addLevel (2) 被 打印 ， 
# 跟踪 生效 

1] "User: : addHighLevel" 
Tracing addLevel (2) on entry 
1] "Member: : addLevel" 

1] "User: : addLevel" 


> ml$untrace ("addlevel") # 取消 对 addLevel () 方法 跟踪 
Untracing reference method "addLevel" for object from class "Member" 
1] "addLlevel" 


使 用 $export () 方法 ， 以 类 为 作用 域 查看 属性 值 。 


> ml$export ('Member') 4 查看 在 Member 类 中 的 属性 
Reference class object of class "Member" 

Field "name": 

[1] "ml" 

Field "level": 


> ml$export ('User') * 查看 在 User 类 中 的 属性 ， 当 前 作用 域 不 包括 age 属性 。 
[1] "User: : initialize" 

Reference class object of class "User" 

Field "name": 

[2] "ml" 

Field "level": 

[1] 105 


使 用 $import () 方法 ， 把 一 个 对 象 的 属性 值 赋值 给 另 一 个 对 象 。 


> m2<-Member$new () # 实例 化 m2 
[1] "User: : initialize" 

> m2 
Reference class object of class "Member" 

Field "name": 

[1] "conan" 

Field "level": 

[1] 1 

Field "age": 

numeric (0) 

> m28import (ml) # 把 ml 对 象 的 值 赋值 给 m2 对 象 
> m2 

Reference class object of class "Member" 

Field "name": 

[1] "ml" 

Field "level": 

[1] 105 

Field "age": 

[1] 12 


2. 内 置 属性 


RC 对 象 实例 化 后 ， 有 两 个 内 置 属性 。 
“ .self， 实 例 化 对 象 自身 。 


' :tefClassDef， 类 的 定义 类 型 。 


> mi$.self 4 $.self 属 性 
Reference class object of class "Member" 

Field "name": 

[1] "ml" 

Field "level": 

[1] 105 

Field "age": 

[1] 12 

> identical (ml1$.self, ml) 4 m1$.self 和 ml 完全 相同 
[1] TRUE 

> otype (ml1$.self) # 查看 类 型 

[1] "Rc" 

> mi$.refClassDef 4$ $.refClassDef/É E 
Reference Class "Member": 

Class fields: 

Name: name level age 

Class: character numeric numeric 

Class Methods: 


"addHighlevel", "addLevel", "addLevel$User", "callSuper", "copy", "export", 
"field", "getClass", "getRefClass", "import", "initFields", 

"initialize", "show", "trace", "untrace", "usingMethods" 

Reference Superclasses: 

"User", "envRefClass" 

> identical (m1$.refClassDef, ml$getClass () ) 4 5$getClass () 相同 

[1] TRUE 


> otype (m1$.refClassDef) # 查看 类 型 


[1] "s4" 


4.4.6 ”RC 类 的 辅助 函数 


当 定 义 好 了 RC 的 类 结构 ， 有 一 些 辅助 函数 可 以 帮助 我 们 查看 类 型 的 属性 和 方法 ， 上 面 用 于 创建 实例 化 的 对 象 的 $new () 函数 ， 也 属于 这 类 辅助 函数 ， 下 面 详细 介绍 这 些 辅助 函数 。 
“ new， 用 于 实例 化 对 象 。 
. help， 用 于 查询 类 中 方法 的 调用 。 
- methods， 列 出 类 中 定义 的 所 有 方法 。 
“ fields， 列 出 类 中 定义 的 所 有 属性 。 
“ lock， 给 属性 加 锁 ， 实 例 化 对 象 的 属性 只 允许 赋值 一 次 ， 即 赋值 变量 ， 不 可 修改 。 
“trace， 跟 踪 方 法 。 


“ accessors， 给 属性 生成 get/set 方 法 。 


接 下 来 ， 我 们 使 用 辅助 函数 ， 继 续 使 用 我 们 之 前 定义 的 User 的 类 的 结构 。 


User<-setRefClass ("User", # 定义 User 类 
fields-list (name-"character", level-'numeric') , 
methods-list ( 

initialize = function (name, level) ( 
print ("User: : initialize") 
name ««- 'conan' 
level ««- 1 

h, 

addLevel = function (x) { 
print ('User: : addLevel') 
level <<- level+x 

h, 

addHighLevel = function () { 
print ('User: : addHighLevel') 
addLevel (2) 
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+) 

> ul«-User$new () 4 实例 化 对 象 U1 

> User$fields () * 列 出 User 类 中 的 属性 
name level 

"character" "numeric" 

> UserSmethods () + 列 出 User 类 中 的 方法 

[1] "addHighLevel" "addLevel" "callSuper" 

"export" "field" 

"getRefClass" 

nitFields" "initialize" 


[13] "trace" "untrace" "usingMethods" 
> User$help ("addLevel") + 查看 User 类 的 方法 调用 
Call: 


SaddLevel (x) 

> User$help ("show") 
Call: 

$show () 


给 User 类 中 的 属性 ， 增 加 get/set 方 法 。 


> User$accessors ("level") # 给 level 属 性 增加 get/set 方 法 
> User$accessors ("name") # 给 name 属 性 增加 get/set 方 法 
> User$methods () + 列 出 所 有 方法 
[1] "addHighLevel" "addLevel" "callSuper" 
copy" "export" "field" 
getClass" "getLevel" "getName" 
[i etRefClass" "import" "initFields" 
[ nitialize" "setLevel" "setName" 
[ how" "trace" "untrace" 
[ 


19] "usingMethods" 


使 用 $trace () 函数 ， 跟 踪 addLeve| 方 法 。 


> User$trace ('addLevel') # 跟踪 User 类 的 addLevel 方 法 

Tracing reference method "addLevel" for class 

"User" 

[1] "addLevel" 

» u3«-User$new (name-'u3', level-1) # 实例 化 对 象 U3 

[1] "User: : initialize" 

» u3$addLevel (2) # addLevel 方 法 调用 ， 出 发 跟踪 日 志 Tracing u3$addLevel (2) 


Tracing u3$addLevel (2) on entry 
[1] "User: : addLevel" 


使 用 $lock () 函数 ， 把 level 属 性 设置 为 常量 。 


> User$lock ("level") # 锁定 level 属 性 

> User$lock () # 查看 User 类 中 被 锁定 的 属性 

1] "level" 

» u3«-User$new () *oXsMt5p£u3, ixsnlevel/£QE ezik 
1] "User: : initialize" 

> u3 


Reference class object of class "User" 

Field "name": 

1] "conan" 

Field "level": 

1] 1 

> u3$level-1 # 给 level1 属 性 ， 再 次 赋值 出 错 

Error: invalid replacement: reference class field 'level' is read-only 
> u3$addLevel (2) 

1] "User: : addLlevel" 

Error: invalid replacement: reference class field 'level' is read-only 


442 ”RC 对 象 系统 的 使 用 


我 们 接 下 用 RC 对 象 系统 做 一 个 例子 ， 定 义 一 套 动物 研究 模型 。 


1. 任 务 一 : 定义 动物 的 数据 结构 和 发 声 方法 


假设 Animal 为 动物 的 基 类 ， 研 究 的 动物 包括 猫 (cat) . 19 (dog) 、 鸭 (duck) 。 需 要 定义 动物 的 数据 结构 ， 并 且 分 别 定义 3 种 动物 的 发 声 bark () 方法 。 结 构 如 图 4-8 所 示 。 


Animal 


图 4-8 任务 一 : 动物 系统 数据 结构 


定义 动物 的 数据 结构 ， 包 括 基 类 的 结构 和 3 种 动物 的 结构 。 


创建 animal 类 ， 包 括 name 属 性 ， 构 造 方法 initialize () ， 叫 声 方法 bark () 。 
Animal<-setRefClass ("Animal", 
fields-list (name-"character") , 
methods-list ( 
initialize = function (name) name ««- 'Animal', 
bark = function () print ("Animal: : bark") 
) 


创建 Cat 类 ， 继 承 Animal 类 ， 并 重 写 (Overwrite) 了 initialize () 和 bark () . 
Cat«-setRefClass ("Cat", contains-"Animal", 
methods-list ( 

initialize = function (name) name ««- 'cat', 

bark = function () print (paste (name, "is miao miao") ) 


) 


创建 Dog 类 ， 继 承 Animal 类 ， 并 重 写 (Overwrite) 了 initialize () 和 bark () . 
Dog<-setRefClass ("Dog", contains="Animal", 
methods-list ( 

initialize = function (name) name <<- 'dog', 

bark = function () print (paste (name, "is wang wang") ) 


) 


创建 Duck 类 ， 继 承 Animal 类 ， 并 重 写 (Overwrite) 了 initialize () 和 bark () . 
Duck«-setRefClass ("Duck", contains-"Animal", 
methods-list ( 
initialize = function (name) name ««- 'duck', 
bark = function () print (paste (name, "is ga ga") ) 


) 
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接 下 来 ， 我 们 实例 化 对 象 ， 然 后 研究 它们 的 叫 声 。 


> cat«-Cat$new () # 创建 cat 实 例 

> cat$name 

1] "cat" 

» cat$bark () 4 cat 叫 声 

1] "cat is miao miao" 

> dog«-Dog$new () # 创建 qdog 实 例 ， 并 给 dog 起 名 叫 Huang 


> dogSinitFields (name-'Huang') 
Reference class object of class "Dog" 
Field "name": 


1] "Huang" 

> dog$name 

1] "Huang" 

> dog$bark () 4 dog 叫 声 

1] "Huang is wang wang" 

» duck«-Duck$new () + 创建 duck 实例 
> duck$bark () # duck" & 


1] "duck is ga ga" 


2. 任 务 二 : ENTIRE 


动物 的 体 貌 特征 ， 包 括 头 、 身 体 、 肢 、 址 等， 我 在 这 里 只 定义 肢 和 码 的 特征 。3 种 动物 都 有 肢 ，cat 和 dog 是 四 肢 ，duck 是 二 胶 和 二 起。 结构 如 


图 4-9 任务 二 


我 们 需要 对 原 结构 进行 修改 。 


: 动物 系统 体 貌 特征 的 数据 结构 


4-9 所 示 。 


# 定义 Animal 类 ， 增 加 1imbs 属 性 ， 默 认 值 为 4 
> Animal«-setRefClass ("Animal", 
fields-list (name-"character", limbs-'numeric') , 
methods-list ( 
initialize = function (name) { 
name ««- 'Animal' 
limbs««-4 


bark = function () print ("Animal: : bark") 


在 Cat 类 的 initialize () 方法 中 ， 执 行 cal1Super () 方法 ， 调 用 父 类 的 同名 方法 
Cat«-setRefClass ("Cat", contains-"Animal", 
methods-list ( 
initialize = function (name) { 
callSuper () 
name <<- 'cat' 
]， 
bark = function () print (paste (name, "is miao miao") ) 


) 


在 Dog 类 的 initialize () 方法 中 ， 执 行 cal1Super () 方法 ， 调 用 父 类 的 同名 方法 
Dog«-setRefClass ("Dog", contains-"Animal", 
methods-list ( 
initialize = function (name) ( 
callSuper () 
name ««- 'dog' 
n 
bark = function () print (paste (name, "is wang wang") ) 


) 


在 Dog 类 的 定义 wing 属 性 ， 并 在 initialize () 方法 ， 定 义 ]imbs 和 wing 属 性 的 默认 值 
Duck«-setRefClass ("Duck", contains-"Animal", 
fields-list (wing-'numeric') , 
methods-list ( 
initialize = function (name) { 
name <<- 'duck' 
limbs««- 2 
wing««- 2 
h, 
bark = function () print (paste (name, "is ga ga") ) 


) 
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实例 化 对 象 并 查看 3 种 动物 的 属性 值 。 


> cat«-Cat$new () ; cat # 实例 化 cat 对 和 象 ， 属 性 1imbs 为 4 
Reference class object of class "Cat" 

Field "name": 

[1] "cat" 

Field "limbs": 

[1] 4 

> dog«-Dog$new () 4 实例 化 dog 对 象 ， 属 性 1imbs 为 4 
> dog$initFields (name-'Huang') 

Reference class object of class "Dog" 

Field "name": 

[1] "Huang" 

Field "limbs": 

[1] 4 

> dog 

Reference class object of class "Dog" 


Field "name": 

[1] "Huang" 

Field "limbs": 

[1] 4 

» duck«-Duck$new () ; duck 4 实例 化 duck 对 和 象 ， 属 性 1imbs 为 2，wing 为 2 
Reference class object of class "Duck" 
Field "name": 

[1] "duck" 

Field "limbs": 

[1] 2 

Field "wing": 

[1] 2 


3. 任 务 三 : 定义 动物 的 行动 方式 


对 于 猫 (cat) 、 狗 (dog) . 88 (duck) 来 说 ， 它 们 都 可 以 在 陆地 上 行动 ， 而 且 还 有 各 自 不 同 的 行动 方式 。 特 有 行动 方式 : 


-3 (cat) , feld 
-3 (dog) ， 游 泳 
-4% (duck) , 游泳 ， 短 距离 飞行 


结构 如 图 4-10 所 示 。 


tname 

tl imbs 
tbark () 
taction() 


+bark () 
+action() 


图 4-10 任务 三 : 动物 系统 行动 方式 的 数据 结构 


接 下 来 ， 我 们 按 动物 的 不 同行 动 方式 进行 建 模 。 


# 定义 类 Animal， 增 加 action () 方法 ， 用 于 通用 的 行为 陆地 上 行动 。 
> Animal«-setRefClass ("Animal", 
fields-list (name-"character", limbs-'numeric') , 
methods-list ( 
initialize = function (name) { 
name ««- 'Animal' 
limbs««-4 
h, 
bark = function () print ("Animal: : bark") , 
action = function () print ("I can walk on the foot") 


) 


定义 Cat 类 ， 重 写 action () Ak, Hgh feihir 
Cat«-setRefClass ("Cat", contains-"Animal", 
methods-list ( 
initialize = function (name) { 
callSuper () 
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name ««- 'cat' 
hn 
bark = function () print (paste (name, "is miao miao") ) , 
action - function () ( 
callSuper () 
print ("I can Climb a tree") 
} 
) 
) 
定义 Dog 类 ， 重 写 action () 方法 ， 并 增加 游泳 行动 
Dog«-setRefClass ("Dog", contains-"Animal", 
methods-list ( 
initialize = function (name) { 
callSuper () 
name ««- 'dog' 
h 
bark = function () print (paste (name, "is wang wang") ) , 
action - function () ( 
callSuper () 
print ("I can Swim.") 


} 
) 


定义 Duck 类 ， 重 写 action () 方法 ， 并 增加 游泳 和 短 距 离 飞行 
Duck«-setRefClass ("Duck", contains-"Animal", 
fields-list (wing-'numeric') , 
methods-list ( 
initialize = function (name) { 
name ««- 'duck' 
limbs««- 2 
wing««- 2 
h, 
bark = function () print (paste (name, "is ga ga") ) , 
action = function () ( 
callSuper () 
print ("I can swim.") 
print ("I also can fly a short way.") 


} 
) 
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实例 化 对 象 ， 并 运行 action () 方法 。 


cat 的 行动 。 
> cat«-Cat$new () # 实例 化 cat 
> cat$action () 4 cat 的 行动 


[1] "I can walk on the foot" 
[1] "I can Climb a tree" 


dog 的 行动 。 


> dog«-Dog$new () 

> dog$action () 

[1] "I can walk on the foot" 
[1] "I can Swim." 


duck 的 行动 。 


> duck«-Duck$new () 

> duck$action () 

[1] "I can walk on the foot" 

[1] "I can swim." 

[1] "I also can fly a short way." 


通过 这 个 例子 ， 我 们 应 该 就 能 全 面 地 了 解 了 R 语 言 中 基于 RC 对 象 系统 的 面向 对 象 程序 设计 了 ! RC 对 象 系统 提供 了 完全 的 面向 对 象 的 实现 ， 书 中 第 6 章 将 会 基于 RC 的 面向 对 象 程序 设计 用 于 游戏 框架 的 开 


4.5”R 语 言 基于 R6 的 面向 对 象 编程 


问题 


如 何 基于 R6 面 向 对 象 系统 编程 ? 
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R 语 言 基于 R6 前 面向 对 象 编程 


http:// blog.fen £me/r-class-r6/ 


R6 是 什么 ? 难道 是 一 种 新 的 类 型 吗 ? 其 实 ， 我 也 是 在 无 意 中 发 现 R6 的 。R6 是 R 语 言 的 一 个 面向 对 象 的 R 包 ，R6 类 型 非常 接近 于 RC 类 型 ， 但 比 RC 类 型 更 轻 ， 由 于 R6 不 依赖 于 S4 的 对 象 系统 ， 所 以 用 R6 构 建 
面向 对 象 系统 会 更 加 有 效率 。 


R6 是 一 个 单独 的 R 包 ， 与 我 们 熟悉 的 原生 的 面向 对 象 系统 类 型 S3，S4 和 RC 类 型 不 一 样 。 在 R 语 言 的 面向 对 象 系统 中 ，R6 类 型 与 RC 类 型 是 比较 相似 的 ， 但 R6 并 不 基于 S4 的 对 象 系统 ， 因 此 我 们 在 用 R6 类 
型 开发 R 包 的 时 候 ， 不 用 依赖 于 methods 包 ， 而 用 RC 类 型 开发 R 包 的 时 候 则 必须 设置 methods 包 的 依赖 。 在 6.5 节 就 会 出 现 RC 依 赖 于 methods 包 的 使 用 情况 。 


R6 类 型 比 RC 类 型 更 符合 其 他 编程 系统 对 于 面向 对 象 的 设置 ， 支 持 类 的 公有 成 员 和 私有 成 员 ， 支 持 函 数 的 主动 绑 定 ， 并 支持 跨 包 的 继承 关系 。 由 于 RC 类 型 的 面向 对 象 系统 设计 并 不 彻底 ， 所 以 才 会 有 R6 
这 样 的 包 出 现 。 下 面 就 让 我 们 体会 一 下 ， 基 于 R6 面 向 对 象 系统 编程 吧 。 


本 节 的 系统 环境 是 : 
* Windows 7 64bit 


- R: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 


我 们 先 安装 R6 包 ， 同 时 为 了 方便 我 们 检查 对 象 的 类 型 ， 引 入 pryr 包 作为 辅助 工具 。 关 于 pryr 包 的 介绍 ， 请 参看 3.1 节 。 


~R # 启动 R 程 序 

> install.packages ("R6") # 安装 R6 包 
> library (R6) # 加 载 R6 包 

> library (pryr) d 加 载 pryr 包 


注 ”R6 同 时 支持 Windows 7 环境 和 Linux 环 境 。 


R6 对 象 系统 是 以 类 为 基本 类 型 ， 有 专门 的 类 的 定义 函数 R6Class () 和 实例 化 对 象 的 生成 方法 ， 下 面 我 们 用 R6 对 象 系统 创建 一 个 类 。 先 查看 R6 的 类 创建 函数 R6Class () 的 定义 。 


> R6Class 

function (classname = NULL, public = list () , private = NULL, 
active = NULL, inherit = NULL, lock = TRUE, class = TRUE, 
portable = TRUE, parent env = parent.frame () ) 


参数 列表 : 
“classname， 定 义 类 名 。 


public， 定 义 公 有 成 员 ， 包 括 公有 方法 和 属性 。 


“ private， 定 义 私 有 成 员 ， 包 括 私 有 方法 和 属性 。 


' active， 主 动 绑 定 的 函数 列表 。 


- inherit， 定 义 父 类 ， 继 承 关 系 。 


"lock， 是 否 上 锁 ， 如 果 上 锁 则 用 于 类 变量 存储 的 环境 空间 被 锁定 ， 不 能 修改 。 


s class， 是 否 把 属性 封装 成 对 象 ， 默 认 是 封装 ， 如 果 选 择 不 封装 ， 类 中 属性 存在 一 个 环境 空间 中 。 


- pottable， 是 否 为 可 移植 类 型 ， 默 认 是 可 移植 类 型 ， 类 中 成 员 访问 需要 调用 self 和 private 对 象 。 


“ parent_env， 定 义 对 象 的 父 环境 空间 。 


从 R6Class () 函数 的 定义 来 看 ， 参 数 比 RC 类 定义 的 setRefClass () 函数 有 更 多 的 面向 对 象 特征 。 


2. 创 建 R6 的 类 和 实例 化 对 象 


我 们 先 创建 一 个 最 简单 的 R6 的 类 ， 只 包括 一 个 公有 方法 。 


> Person <- R6Class ("Person", 


* public-list ( 

+ hello = function () ( # 定义 公有 方法 hello 
+ print (paste ("Hello") ) 

+ ) 

+} 

+) 

> Person # 查看 Person 的 定义 


«Person» object generator 


Public: 


hello: function 


Parent 
Lock: 


env: «environment: 


TRUE 


Portable: TRUE 
> class (Person) 
[1] "R6ClassGenerator" 


# 定义 一 个 R6 类 


R GlobalEnv» 


# 检查 Person 的 类 型 


接 下 来 ， 实 例 化 Person 对 象 ， 使 


> ul«-Person$new () 


> ul 
<Person> 


Public: 


hello: function 


> class ( 


ul) 


[1] "Person" "R6" 


通过 pryr 包 的 otype 检 查 Person 类 的 类 型 和 u1 对 象 的 实例 化 类 型 。 


> otype (Person) 


$new () 函数 完成 。 


4 实例 化 一 个 Person 对 象 ul 


# 查 看 u1 对 象 


# 检查 u1 的 类 型 


# 查看 Person 类 型 


[1] "S3" 
» otype (ul) + 查看 Ul 类 型 
[1] "sa" 


完全 没有 想到 的 结果 ，Person 和 u1 都 是 $3 类 型 的 。 如 果 R6 是 基于 53 系统 构建 的 ， 那 么 其 实 就 可 以 解释 R6 类 型 与 RC 类 型 的 不 同 ， 并 且 R6 在 传 值 和 继承 上 会 更 有 效率 。 


3. 公 有 成 员 和 私有 成 员 


类 的 成 员 ， 包 括 属 性 和 方法 两 部 分 。R6 类 定义 中 ， 可 以 分 开设 置 公有 成 员 和 私有 成 员 。 我 们 设置 类 的 公有 成 员 ， 修 改 Person 类 的 定义 ， 在 public 参 数 中 增加 公有 属性 name， 并 通过 hello () 方法 打印 
name 的 属性 值 ， 让 这 个 R6 的 类 更 像 是 Java 语 言 的 JavaBean。 在 类 中 访问 公有 成 员 时 ， 需 要 使 用 self 对 象 进行 调用 。 


> Person <- R6Class ("Person", 


+ public-list ( 

十 name-NA, # 公有 属性 

+ initialize = function (name) { # 构建 函数 方法 
* self$name «- name 

* h 

+ hello = function () { # 公有 方法 

十 print (paste ("Hello", self$name) ) 

+ ) 

+ J 

+) 

> conan <- Person$new ('Conan') # 实例 化 对 象 
> conan$hello () # 调用 用 hello O 方法 


[1] "Hello Conan" 


接 下 来 设置 类 的 私有 成 员 ， 给 Person 类 中 增加 private 参 数 ， 并 在 公有 函数 中 调用 私有 成 员 变量 ， 调 用 私有 成 员 变量 时 ， 要 通过 private 对 象 进行 访 问 。 


> Person <- R6Class ("Person", 
public-list ( + 公有 成 员 
name=NA, 
initialize = function (name, gender) { 
self$name «- name 
private$gender«- gender # 给 私有 属性 赋值 


]， 
hello = function () ( 
print (paste ("Hello", self$name) ) 
private$myGender () # 调用 私有 方法 
} 
E 
private=list ( # 私有 成 员 
gender-NA, 
myGender-function () { 
print (paste (self$name, 


is", private$gender) ) 


) 
conan «- Person$new ('Conan', 'Male') + 实例 化 对 象 
conan$hello () # 调用 hello () 方法 

] "Hello Conan" 
] "Conan is Male" 
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在 给 Person 类 中 增加 私有 成 员 时 ， 通 过 private 参 数 定义 gender 的 私有 属性 和 myGender () 的 私有 方法 。 值 得 注意 的 是 在 类 的 内 部 ， 要 访问 私有 成 员 时 ， 需 要 用 private 对 象 进行 调用 。 当 直接 访问 公 
有 属性 和 私有 属性 时 ， 公 有 属性 返回 正确 ， 而 私有 属性 就 返回 NULL 值 ， 并 且 访 问 私有 方法 不 可 见 。 


> conan$name 

[1] "Conan" 

> conan$gender 
NULL 

> conan$myGender () 
Error: attempt to apply non-func 


+ 公有 属性 


+ 私有 属性 
# 私有 方法 


tion 


进一步 地 ， 我 们 看 看 self 对 象 和 private 对 象 具体 是 什么 。 在 Person 类 中 ， 增 加 公有 方法 member () , member () 方法 中 分 别 打印 self 对 象 和 private 对 象 。 


Person «- R6Class ("Person", 
public-list ( 
name-NA, 
initialize = function (name 
self$name «- name 
private$gender«- gender 
um 
hello = function () ( 


private$myGender () 
h 
member = function () { 
print (self) 
print (private) 
print (ls (envir-private) 
} 
E 
private=list ( 
gender=NA, 
myGender=function () { 
print (paste (self$name, 
} 
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> 


, gender) { 


print (paste ("Hello", self$name) ) 


# 用 于 测试 的 方法 


) 


is", private$gender) ) 


> conan <- Person$new ('Conan', 'Male') 


> conan$member () 
«Person» 
Public: 
hello: function 
initialize: function 
member: function 
name: Conan 
«environment:  0x0000000008cfc918 
[1] "gender" "myGender" 


# 执行 member () 方法 
# print (self) 的 输出 


> # print (private) 的 输出 
# print (ls (envir-private) ) 的 输出 


从 测试 结果 我 们 可 以 看 出 self 对 象 就 是 实例 化 的 对 象 本 身 。private 对 象 则 是 一 个 环境 空 


会 找 不 到 。 在 环境 空间 中 保存 私有 成 员 的 


4.5.3 R6 类 的 主动 绑 定 


属性 和 方法 ， 通 过 环境 空间 的 访问 控制 让 外 部 调 


间 ， 是 self 对 象 所 在 环境 空间 的 一 个 子 环境 空间 


， 所 以 私有 成 员 只 能 在 当前 的 类 中 被 调 有 


无 法 使 用 私有 属性 和 方法 ， 这 种 方式 是 经 常 被 


在 R 包 开发 上 的 技巧 。 


， 外 部 访问 私有 成 员 时 就 


主动 绑 定 (active binding) 是 R6 中 一 种 特殊 的 函数 调用 方式 ， 把 对 函数 的 访问 表现 为 对 属性 的 访问 。 主 动 绑 定 属于 公有 成 员 。 在 类 定义 中 ， 通 过 设置 active 参 数 实现 主动 绑 定 的 功能 ， 给 Person 类 增 


加 两 个 主动 绑 定 的 函数 active 和 rand。 


> Person <- R6Class ("Person", 


+ public = list ( 

* num = 100 

+ E. 

+ active = list ( # 主动 绑 定 

十 active = function (value) { 

* if (missing (value) ) return (self$num 410 ) 
* else self$num «- value/2 

本 h 

+ rand = function () rnorm (1) 

tod 

*) 

> conan «- Person$new () 

» conan$num # 查看 公有 属性 

[1] 100 

> conan$active + 调用 主动 绑 定 的 active () 函数 ， 结 果 为 num +10= 100+10=100 
[1] 110 


给 主动 绑 定 的 active 函 数 传 参数 ， 这 里 传 参数 要 用 赋值 符号 "<-" ， 而 不 能 是 方法 调 


"0*5 


* 传 参数 


> conan$active<-100 
> conan$num 


# 查看 公有 属性 num 


[1] 50 

> conan$active + 调用 主动 绑 定 的 active () 函数 ， 结 果 为 numt10=50+10=60 
[1] 60 

> conan$active (100) # 如 果 进 行 方法 调用 ， 其 实 会 提示 没有 这 个 函数 的 

Error: attempt to apply non-function 

我 们 再 来 调用 rand 函 数 ， 看 看 执行 情况 。 

> conan$rand # 调用 rand 函 数 

[1] -0.4767338 

> conan$rand 

[1] 0.1063623 

> conan$rand«-99 t 传 参 出 错 

Error in (function () unused argument (quote (99) ) 

我 们 直接 使 用 rand () 函数 完全 没有 问题 ， 但 给 rand () 函数 传 参数 的 时 候 就 出 现 了 错误 ， 由 于 rand () 函数 没有 定义 参数 ， 所 以 这 个 操作 是 不 允许 的 。 


通过 主动 绑 定 ， 可 以 把 函数 的 行为 转换 成 属性 的 行为 ， 让 类 中 的 函数 操作 更 加 灵活 。 


4.5.4 R6 类 的 继承 关系 


继承 是 面向 对 象 的 基本 特征 ，R6 的 面 


向 对 象 系统 也 是 支持 继承 的 。 当 你 创建 一 个 类 时 ， 可 以 继承 另 一 个 类 作为 父 类 存在 。 下 面 先 创建 一 个 父 类 Person， 包 括 公 有 成 员 和 私有 成 员 。 


Person <- RéClass ("Person", 
public-list ( + 
name=NA, 
initialize = function (name 
self$name <- name 
private$gender <- gender 


]， 
hello = function () { 


private$myGender () 
} 
) 


> 
ge 
十 
十 
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+  private-list ( 


公有 成 员 


，gender) ( 


print (paste ("Hello", self$name) ) 


# 私有 成 员 


gender-NA, 
myGender-function () { 
print (paste (self$name, 
} 
) 


"is", private$gender) ) 


十 十 十 十 十 


创建 子 类 Worker 继 承 父 类 Person， 并 在 子 类 增加 bye () 公有 方法 。 


> Worker «- R6Class ("Worker", 
+ inherit = Person, # 继承 ， 指 向 父 类 
+  public-list ( 

* bye = function () { 

+ 

4 

+ 


print (paste ("bye", self$name) ) 
) 


实例 化 父 类 和 子 类 ， 看 看 继承 关系 是 不 是 生效 了 。 


> ul«-Person$new ("Conan", "Male") # 实例 化 父 类 
> ul$hello () 

[1] "Hello Conan" 

[1] "Conan is Male" 

» u2«-Worker$new ("Conan", "Male") 
> u2$hello () 

[1] "Hello Conan" 

[1] "Conan is Male" 

» u2$bye () 

[1] "bye Conan" 


+ 实例 化 子 类 


我 们 看 到 继承 确实 生效 了 ， 在 子 类 中 我 们 并 没有 定义 hello () 方法 ， 


子 类 u2 可 以 直接 使 有 


接 下 来 ， 我 们 在 子 类 中 定义 父 类 的 同名 方法 ， 然 后 再 查看 方法 的 调 


， 看 看 是 否 会 出 现 继承 中 函数 时 


hello () 方法 。 同 时 ， 子 类 u2 的 bye () 方法 ， 到 了 在 父 类 中 定义 的 name 属 性 ， 


写 的 特征 。 修 改 Worker 类 ， 在 子 类 定义 private 的 属性 和 方法 。 


输出 结果 是 完全 正确 的 。 


> Worker «- R6Class ("Worker", 
inherit = Person, 
public-list ( 
bye = function () ( 
print (paste ("bye", self$name) ) 


Ja 
private-list ( 
gender-NA, 
myGender-function () { 
print (paste ("worker", self$name, 


十 十 十 十 十 十 十 十 十 十 十 十 


"is", private$gender) ) 


实例 化 子 类 ,， 调 


hello () 方法 。 


> u2«-Worker$new ("Conan", "Male") 

> u2$hello () # 调用 hello 0 方法 
[1] "Hello Conan" 

[1] "worker Conan is Male" 


由 于 子 类 中 的 myGender () 私有 方法 覆盖 了 父 类 的 myGender () 私有 方法 ， 所 以 在 调用 hello () 方法 时 ，hello () 方法 会 调 有 


myGender () 方法 。 


如 果 在 子 类 中 想 调 


父 类 的 方法 ， 有 一 个 办 法 是 使 


Worker «- R6Class ("Worker", 
inherit = Person, 
public-list ( 

bye = function () { 
print (paste ("bye", self$name) ) 
} 

Fa 

private=list ( 
gender=NA, 


super$myGender () # 调用 父 类 的 方法 


super 对 象 ， 通 过 super$xx () 的 语法 进行 调 


print (paste ("worker", self$name, "is", private$gender) ) 


) 


«-Worker$new ("Conan", "Male") 
Shello () 

"Hello Conan" 

"Conan is Male" 

"worker Conan is Male" 


> 

+ 

Ls 

+ 

+ 

+ 

+ 

本 

十 

* myGender-function () { 
本 

十 

$ 

本 

4 

> u2 
> u2 
[ 

[ 

[ 


) 
u 
u 
] 
3 
ij 


1 
1 
1 


子 类 中 的 myGender () 方法 实现 ， 而 忽略 了 父 类 中 的 


4.5 


5 ”R6 类 对 象 的 静态 


在 子 类 myGender () 方法 中 ， 


super 对 象 调 


属性 


i 
E 


属性 的 值 保存 了 对 象 的 引 


， 而 非 对 象 实例 本 身 。 利 


代码 描述 一 下 就 很 容易 理解 。 定 义 两 个 类 A 和 B，A 类 中 有 一 个 公有 


这 个 规则 就 可 以 实现 对 象 的 静态 属性 


面向 对 象 的 方法 进行 编程 ， 那 么 所 有 变量 其 实 都 是 对 象 ， 我 们 可 以 把 一 个 实例 化 的 对 象 定义 成 另 一 个 类 的 


父 类 的 myGender () 方法 ， 从 输出 可 以 看 出 ， 父 类 的 同名 方法 也 同时 被 调 有 


属性 x，B 类 中 有 一 个 公有 


属性 a，a 为 A 类 的 实例 化 对 象 。 


属性 ， 这 样 就 形成 了 对 象 的 引 


关系 链 。 需 要 注意 的 一 点 是 ， 当 


属性 赋值 为 另 一 个 R6 的 对 象 


也 就 是 可 以 在 多 种 不 同 的 实例 中 共享 对 象 


属性 ， 类 似 于 Java 中 的 static 属 性 。 


> A <- R6Class ("A", 
* public-list ( 
* x = NULL 
) 
) 


B <- RéClass ("B", 
public = list ( 
a = A$new () 

) 


二 十 十 VYV+++ 


运行 程序 ， 实 现 B 类 的 实例 化 对 象 b 对 A 类 的 实例 化 对 象 a 的 调 有 


， 并 给 x 变 


赋值 。 


> b <- B$new () # 实例 化 B 对 象 
> b$a$x <- 1 * 给 x 值 
> b$a$x # 查看 x 变量 的 值 


[11] 

» b2 «- B$new () 实例 化 b2 对 象 

> b28a$x <- 2 Y NU. 

> b2$a$x # 查看 x 变 量 的 值 

[1] 2 

> b$a$x * P 实 例 的 a 对 象 的 x 值 也 发 生 改 变 
[1] 2 


从 输出 结果 可 以 看 到 ，a 对 象 实现 了 在 多 个 b 对 象 之 间 的 共享 ， 当 b2 对 象 修改 了 a 对 象 中 x 值 的 时 候 ，b 实 例 的 a 对 象 的 x 值 也 发 生 了 变化 。 这 里 有 一 种 写法 是 应 该 要 避免 的 ， 就 是 通过 initialize () 方法 赋 
值 。 


C <- RéClass ("C", 

public = list ( 
a = NULL, 
initialize = function () ( 

a <<- A$new () 

} 

) 

) 

cc <- C$new () 

cc$a$x «- 1 

cc$a$x 


VVV+++++++Vv 


> cc$a$x oxi ACE 
1] 


通过 initialize () 构建 的 a 对 象 ， 是 对 单独 的 环境 空间 中 的 引用 ， 所 以 不 能 实现 引用 对 象 的 共享 。 


4.5.6”R6 类 的 可 移植 类 型 


在 R6 类 的 定义 中 ，portable 参 数 可 以 设置 R6 类 的 类 型 为 可 移植 类 型 和 不 可 移植 类 型 。 可 移植 类 型 和 不 可 移植 类 型 主要 有 2 个 明显 的 特征 。 


“ 可 移植 类 型 支持 跨 R 包 的 继承 ; 不 可 移植 类 型 ， 在 跨 R 包 继承 的 时 候 ， 兼 容 性 不 太 好 。 


“ 可 移植 类 型 必须 要 用 self 对 象 和 private 对 象 来 访问 类 中 的 成 员 ， 如 self8x，private$y; 不 可 移植 类 型 ， 可 以 直接 使 用 变量 x，y， 并 通过 <<- 实 现 赋值 。 


本 节 中 使 用 的 是 R6 的 最 新 版 本 2.0， 所 以 默认 创建 的 是 可 移植 类 型 。 所 以 ， 当 我 们 要 考虑 是 否 有 跨 包 继承 的 需求 时 ， 可 以 在 可 移植 类 型 和 不 可 移植 类 型 之 间 进 行 选择 。 


我 们 比较 RC 类 型 、R6 的 可 移植 类 型 和 R6 的 不 可 移植 类 型 三 者 的 区 别 ， 定 义 一 个 简单 的 类 ， 包 括 一 个 属性 x 和 两 个 方法 getx () ，setx () 。 


RC <- setRefClass ("RC", * RC 类 型 的 定义 
fields = list (x = 'Hello') , 
methods - list ( 
getx = function () x, 
setx = function (value) x ««- value 


) 

rc <- RC$new () 
rc$setx (10) 
rc$getx () 

1] 10 


VVV++++++Vv 


创建 一 个 行为 完全 一 样 的 不 可 移植 类 型 的 R6 类 。 


> NR6 <- R6Class ("NR6", + R6 不 可 移植 类 型 
+ portable = FALSE, 

+ public = list ( 

+ x= NA, 

+ getx = function () x, 

+ setx = function (value) x <<- value 

4 

4 


) 


) 
> np6 <- NR6$new () 
> np6$setx (10) 
> np6$getx () 
[1] 10 


再 创建 一 个 行为 完全 一 样 的 可 移植 类 型 的 R6 类 。 


> PR6 «- R6Class ("PR6", 

+ portable = TRUE, + R6 可 移植 类 型 
+ public = list ( 

+  x-NA, 

* getx = function () self$x, 

* setx = function (value) self$x «- value 
IR. 

十 

> 

> 

> 

[ 


) 
pr6 <- PR6$new () 
pr6$setx (10) 

pr6$getx () 
1] 10 


从 这 个 例子 中 可 以 看 出 ， 可 移植 类 型 的 R6 类 和 不 可 移植 类 型 的 区 别 就 在 于 self 对 象 的 使 用 。 


4.5.7”R6 类 的 动态 绑 定 


对 于 静态 类 型 的 编程 语言 来 说 ， 一 旦 类 定义 后 ， 就 不 能 再 修改 类 中 的 属性 和 方法 ， 像 反射 这 样 的 高 开销 的 特殊 操作 除外 。 而 对 于 动态 类 型 的 编程 语言 来 说 ， 通 常 不 存在 这 样 的 限制 ， 可 以 任意 修改 其 类 
的 结构 或 者 已 实例 化 的 对 象 的 结构 。 R 作 为 动态 语言 来 说， 同样 是 支持 动态 变量 修改 的 ， 基 于 S3 类 型 和 94 类 型 可 以 通过 泛 型 函数 动态 地 增加 函数 定义 ， 但 RC 类 型 是 不 支持 的 ， 再 次 感觉 到 了 R 语 言 中 面向 对 
象 系统 设计 的 奇 苑 了 。 


R6 包 已 考虑 这 个 情况 ， 提 供 了 一 种 动态 设置 成 员 变 量 的 方法 调用 $set () 函数 。 


> A «- R6Class ("A", 

+ public = list ( 

* x - 1, 

十 getx = function () x 

十 

T3 

> A$set ("public", "getx2", function () self$x*2) # 动态 增加 getx2 () 方法 
> s <- A$new () 

>s # 查看 实例 化 对 象 的 结构 


<A> 

Public: 
getx: function 
getx2: function 
xt d 

» s$getx2 () 

[1] 20 


* 调用 getx2 0 方法 


同样 ， 属 性 也 可 以 动态 修改 ,动态 改变 x 


属性 的 值 。 


> A$set ("public", 
> s <- A$new () 

> s$x 

[1] 10 

» s$getx () 

Error in s$getx () 


x", 10 


, overwrite = TRUE) 


oseÓGxE 


+ 查看 x 属性 


# 调用 getx () 方法 ， 可 移植 类 型 x 变量 丢失 


object 'x' not found 


由 于 A 类 默认 是 可 移植 类 型 的 ， 所 以 在 使 


x 变 量 时 应 该 通过 self 对 象 来 访问 ， 和 否则 动态 成 员 修改 的 时 候 ， 就 会 出 现 错误 ， 我 们 把 getx 中 的 x 改 为 self$x。 


A «- RéClass ("A", 
public = list ( 
x-1, 


getx = function () self$x 


) 

A$set ("public", 
s <- RSnew () 
SSX 

1] 10 

s$getx () 

1] 10 


"x", 10, 


一 V 一 VVYVT++ 二 十 十 V 


+ 修改 为 self$x 


overwrite = TRUE) 


# 调用 getx () 方法 


对 于 可 移植 类 型 和 不 可 移植 类 型 ， 建 议 大 家 都 使 


4.5.8 R6 类 的 打印 函数 


self 和 private 对 象 进行 访问 。 


R6 提 供 了 用 于 打印 的 默认 方法 print () ， 每 当 要 打印 实例 化 对 象 时 ， 都 会 调用 这 个 默认 的 print () 方法 ， 有 点 类 似 于 Java 类 中 默认 的 toString () 方法 。 我 们 可 以 覆盖 print () 方法 ， 使 用 自 定义 的 
打印 提示 。 
> A <- R6Class ("A", 
+ public = list ( 
* x-1, 
* getx = function () self$x 
+ 
*) 
> a <- RSnew () 
» print (a) # 使 用 默认 的 打印 方法 
<A> 
Public: 
getx: function 
xz d 


自 定义 打印 方法 ， 履 盖 print () 方法 。 


> A <- R6Class ("A", 
public = list ( 
x-1, 
getx = function () 
print 


self$x, 


cat (1s (self) , 
invisible (self) 
) 
) 


sep-", ") 


) 

a <- A$new () 

print (a) 

lass «A» of public getxprintx : 


DVV+++++ 二 十 十 十 十 


cat ("Class «A» of public ", 


ls (self) , DU, sep="") 


getx, print, x 


function (http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...) { 


通过 自 定义 的 方法 ， 就 可 以 覆盖 系统 默认 的 方法 ， 从 而 输出 我 们 想 显示 的 文字 。 


4.5.9 ”实例 化 对 象 的 存储 


R6 是 基于 S3 面 向 对 象 系统 的 构建 ， 而 S3 类 型 又 是 一 种 比较 松散 的 类 型 ， 会 造成 用 户 环境 空间 的 
到 一 个 $3 对 象 中 ， 这 种 方式 是 默认 的 。 另 一 种 方式 为 ， 把 类 中 定义 的 


d ERES 
Emz] 


监 的 问题 。 R6 提 供 了 一 种 方式 ， 设 置 R6Class () 的 class 参 数 ， 把 类 中 定义 的 


属性 和 方法 统一 存储 


属性 和 方法 统一 存储 到 一 个 单独 的 环境 空间 中 。 我 们 查看 一 下 默认 的 情况 ，class=TRUE， 实 例 化 后 的 a 对 象 ， 就 是 一 个 S3 的 类 。 


> A <- R6Class ("A", 
class-TRUE, 
public = list ( 
x-1, 
getx = function () 


) 


a <- A$new () 
class (a) 

1] "A" "Ré" 
a 


self$x 


VVV++++++ 


e 


Public: 
getx: 
x; 1 


function 


当 class=FALSE 时 ， 实 例 化 后 的 a 对 象 ， 是 一 个 环境 空间 ， 


在 环境 空间 中 存储 了 类 的 变量 数据 。 


B «- RéClass ("B", 
Class-FALSE, 
public = list ( 
x=], 
getx = function () 


) 


self$x 


«- B$new () 
lass (b) 

1] "environment" 
environment:  0x000000000d83c970» 
s (envir-b) 


"getx" "x" 


> 
+ 
本 
本 
十 
4 
4 
> 
> 
[ 
> 
< 
> 
[ x 


) 
b 
c 
1 
b 
n 
1 
] 


1 


实例 化 对 象 的 存储 还 有 另外 一 方面 的 考虑 ， 由 于 类 中 的 变量 都 是 存在 于 一 个 环境 空间 中 的 ， 我 们 也 可 以 通过 手动 的 方式 找到 这 个 环境 空间 ， 从 而 进 
量 进行 修改 ， 那 么 会 给 我 们 的 程序 带 来 一 些 安全 上 的 风险 ， 所 以 为 了 预防 安全 上 的 问题 ， 可 以 通过 R6Class () 的 lock 参 数 锁 定 环境 空间 ， 不 允许 动态 修改 ， 默 认 值 为 锁定 状态 不 能 修改 。 


行 变 


量 的 增加 或 修改 。 如 果 随 意 地 对 环境 空间 中 的 变 


> A <- R6Class ("A", 
+ — Lock-TRUE, 

+ public = list ( 
+ x-1 

de 3 

*) 

> s«-A$new () 

> 工 

[1] "x 

> s$aa«-11 


Error in s$aa <- 11 : 


» rm ("x", envir-s) 


Error in rm ("x", envir = s) 


# 锁定 环境 空间 


# 查看 s 环 境 空间 的 变量 


# 增加 新 变量 ， 错 误 
cannot add bindings to a locked environment 


*OMHOSCE EE, HB 


cannot remove bindings from a locked environment 


如 果 不 锁定 环境 空间 ， 让 lock=FALSE， 则 环境 空间 处 于 完全 开放 的 状态 ， 可 以 任意 进行 变量 的 修改 。 


A «- R6Class ("A", 
lock-FALSE, 
public - list ( 

x-1 


) 


ls (s) 
1] "x" 


1 


> 
+ 

+ 

+ 

+ 

+ 

> s<-A$new () 
> 

[ 

» 

> 

[ 

> "x", envir=s) 
> ) 

[ 


通过 上 面 对 R6 的 介绍 ， 我 们 就 基本 掌握 R6 面 向 对 象 系统 的 知识 。 接 下 来 ， 我 们 做 一 个 简单 的 例子 ， 应 


4.5.10 ”R6 面 向 对 象 系统 的 案例 


我 们 用 R6 的 面向 对 象 系统 ， 来 构建 一 个 图 书 分 类 的 使 


1. 任 务 一 : 定义 图 书 的 静态 结构 


E 不 锁定 环境 空间 


+ 查看 s 环 境 空间 的 变量 
# 增加 变量 


+ 删除 变量 


案例 。 


以 图 书 (book) 为 父 类 ， 包 括 R，Java，PHP 的 3 个 分 类 ， 在 book 类 中 定义 私有 


属性 及 公有 方法 ， 继 承 关 系 如 


一 下 R6 的 面向 对 象 编程 。 


图 4-11 所 示 。 


category 


getPrice() 


Java 


图 4-11 任务 一 : 图 书 数据 结构 


定义 图 书 系统 的 数据 结构 ， 包 括 父 类 的 结构 和 3 种 类 型 的 图 书 。 


Book <- R6Class ("Book", + 父 类 
private = list ( 
title=NA, 
price-NA, 
category-NA 
) ， 
public = list ( 
initialize = function (title, price, category) { 
private$title «- title 
privateSprice <- price 
privateS$category <- category 
u 
getPrice-function () ( 
private$price 


) 

R <- R6Class ("R", # 子 类 R 图 书 
inherit = Book 

) 


Java <- R6Class ("JAVA", # 子 类 JAVA 图 书 
inherit = Book 


Php «- R6Class ("PHP", # 子 类 PHP 图 书 
inherit = Book 


十 V+ 二 Vt 十 V+ 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 V 


出 


创建 3 个 实例 化 对 象 ，R 语 言 图书 《R 的 极 客 理 想 一 一 工具 篇 》，Java 语 言 图 书 《Java 编 程 思想 》，PHP 语 言 图 书 《Head First PHP&MySQL》， 并 获得 | 


书 的 定价 。 


D 


> rl«-R$new ("R 的 极 客 理想 -工具 篇 "，59，"R") 
> rl$getPrice () 

[1] 59 

> jl«-Java$new ("Java 编 程 思 想 "，108，"JAVA") 
> jl$getPrice () 

[1] 108 


> pl«-Java$new ("Head First PHP & MySQL", 98, "PHP") 
> pl$getPrice () 
[1] 98 


i] 


2. 任 务 二 : 正 着 双 11 对 各 类 图 书 打 折 促 销 


我 们 设计 一 种 打折 规则 ， 用 来 促进 图 书 的 销售 。 不 过 这 个 规则 纯 属 虚 构 。 


“ 所 有 图 书 9 折 。 


' Java 图 书 7 折 ， 不 支持 重复 打折 。 
: 为 了 推动 R 图 书 的 销售 ，R 语 言 图 书 7 折 ， 并 支持 重复 打折 。 


- PHP 图 书 无 特别 优惠 。 


[ 


根据 打折 规则 ， 图 书 都 可 以 被 打折 ， 那 么 打折 就 可 以 作为 图 书 对 象 的 一 个 行为 ， 然 后 R，Java，PHP 的 3 类 图 书 ， 分 别 还 有 自己 的 打折 规则 ， 所 以 是 一 种 多 态 的 表现 。 


我 们 修改 父 类 的 定义 ， 增 加 打折 的 方法 discount () ， 默 认 设置 为 9 折 ， 满 足 第 一 条 规则 。 


Book «- R6Class ("Book", 
private - list ( 
title-NA, 
price-NA, 
category-NA 


public = list ( 
initialize = function (title, price, category) { 
privateStitle «- title 
privateS$price <- price 
privateS$category <- category 


getPrice-function Ot 
p«-private$price*self$discount () 
print (paste ("Price: ", private$price, ", Sell out: ", p, sep-"") ) 


discount-function Ot 
0.9 


十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 V 


3 个 子 类 ， 分 别 对 应 自己 的 打折 规则 ， 分 别 进行 修改 。 


: 给 Java 子 类 增加 discount () 方法 ， 用 于 履 盖 父 类 的 discount () 方法 ， 让 Java 图 书 7 折 ， 不 支持 重复 打折 ， 从 而 满足 第 二 条 规则 。 
' 给 R 子 类 增加 discount () 方法 ， 在 子 类 的 discount () 方法 中 调用 父 类 的 discount () 方法 ， 让 支持 R 图 书 7 折 和 9 折 的 折 上 折 ， 从 而 满足 第 三 条 规则 。 


“ PHP 子 类 ， 没 有 修改 ， 完 全 遵循 第 一 条 规则 的 。 


Java <- R6Class ("JAVA", 
inherit = Book, 
public = list ( 
discount-function () ( 
0.7 


} 
) 


R <- R6Class ("R", 
inherit - Book, 
public - list ( 
discount-function () ( 
super$discount () *0.7 
} 
) 


Php «- R6Class ("PHP", 
inherit = Book 


十 V+ 十 十 十 十 十 十 V+ 十 十 十 十 十 十 VV 


分 别 查 看 3 本 图 书 的 折 后 价格 。 


> ri«-R$new ("R 的 极 客 理想 -工具 篇 "，59，"R") 
> rl$getPrice () 


[1] "Price: 59, Sell out: 37.17" $ 59 * 0.9 *0.7- 37.17 

> 

> j1<-Java$new ("Java 编 程 思想 "，108，"JAVA") 

> jl$getPrice () 

[1] "Price: 108, Sell out: 75.6" # 108 *0.7- 75.6 

> 

> pl«-Php$new ("Head First PHP & MySQL", 98, "PHP") 

» pl$getPrice () 

[1] "Price: 98, Sell out: 88.2" 4 98 *0.9- 88.2 

R 图 书 打折 最 多 ， 享 受 7 折 和 9 折 的 折 上 折 优惠 ，59*0.9*0.7=37.17; Java 图 书 享受 7 折 优 惠 ，108*0.7=75.6; PHP 图 书 享受 9 折 优惠 98*0.9=88.2。 


通过 这 个 实例 ， 我 们 用 R6 的 方法 实现 了 面向 对 象 编程 中 的 封装 、 继 承 和 多 态 的 3 个 特征 ， 证 明 R6 是 一 种 完全 的 面向 对 象 的 实现 。 R6 类 对 象 系统 ， 提 供 了 一 种 可 兼容 的 面向 对 象 实现 方式 ， 更 接近 于 其 他 
的 编程 语言 上 的 面向 对 象 的 定义 ， 由 于 R6 底 层 是 基于 S3 来 实现 的 ， 所 以 比 RC 的 类 更 加 有 效果 。 


我 们 一 共 介绍 了 4 种 R 语 言 的 面向 对 象 体系 结构 ， 选 择 自己 理解 的 ， 总 有 一 种 会 适合 你 。 


第 三 部 分 “开发 自己 的 R 包 


a 第 5 章 。”R 包 开发 


第 6 章 。R 语 言 游戏 之 旅 


985: REFÈ 


本 章 介绍 R 包 开发 的 方法 。 通 过 底层 R 语 言 函 数 从 头 构建 R 包 是 复杂 的 ， 用 devtools 包 就 可 以 帮助 我 们 简化 开发 流程 。 通 过 每 日 中 国 天 气 应 用 的 R 包 开发 实例 ， 帮 助 读者 全 面 了 解 R 包 开发 的 过 程 。 


5.1 从头 开发 自己 的 R 包 


问题 


如 何 开发 一 个 R 包 ? 


> sayHello<-function(name) | 

十 print(paste("Hel lo", name)) 
T3 

> sayHello("word") 

[1] "Hello word" 


R 是 一 个 世界 范围 开发 者 共同 协作 的 产物 ， 至 2014 年 9 月 共计 近 5887 个 包 可 在 互联 网 上 自由 下 载 。 现 在 我 们 作为 语言 的 使 用 者 ， 有 彰 一 日 也 可 以 成 为 R 语 言 的 开发 者 ， 把 我 们 自己 的 知识 做 成 R 语 言 工具 
包 分 享 给 世界 。 本 节 我 们 将 学 习 如 何 开发 一 个 自己 的 R 包 。 
5.1.1 用 Linux 命 令 行 开 发 R 包 


让 我 们 从 零 开始 创建 一 个 R 包 ， 仅 通过 Linux 命 令 行 就 可 以 完成 全 部 的 操作 。 我 们 将 按照 创建 R 项 目 、 打 包 R 页 目 、 安 装 R 包 、 使 用 R 包 、 检 查 R 包 、 印 载 R 包 6 个 步骤 介绍 R 包 的 开发 。 开 发 R 包 到 底 有 多 
难 ， 只 有 你 试 了 才 知 道 。 


本 节 的 系统 环境 是 : 

+ linux: Ubuntu Server 12.04.2 LTS 64bit 

< R: 3.1.1 x86_64-pc-linux-gnu (64-bit) 

注 ”R 包 开发 同时 支持 Windows 7 环境 和 Linux 环 境 ， 为 了 减少 发 布 时 的 错误 ， 建 议 选择 Linux 环 境 开 发 ， 本 书 6.5 节 介绍 在 Windows 7 中 开发 R 包 。 
1. 创 建 sayHello 项 目 


创建 一 个 R 包 ， 要 如 何 开始 呢 ? 第 一 步 ， 先 给 项 目 起 个 名 字 ， 比 如 sayHello， 然 后 创建 项 目 工作 目录 /home/conan/R/demo。 


~ mkdir /home/conan/R/demo * 创建 目录 ~ cd /home/conan/R/demo # 进入 目录 


第 二 步 ， 在 项 目 中 新 建 R 文 件 sayHello.R， 自 定义 一 个 sayHello 的 函数 ， 作 为 自 定义 包 的 第 一 个 函数 。 


~ vi sayHello.R 4 新 建 sayHello.R 
saylHello«-function (name) { 

print (paste ("Hello", name) ) 
} 


第 三 步 ， 用 系统 的 原生 的 package.skeleton () 函数 ， 生 成 sayHello 项 目的 骨架 。 


~R *OBSRE 

> rm (list-ls () ) # 清空 变量 设置 工作 目录 

> setwd ("/home/conan/R/demo") # 设置 项 目 目录 

> package.skeleton (name-"sayHello", code files-"/home/conan/R/demo/sayHello.R") 


# 通过 sayHe1l11lo 的 脚本 生成 项 目 骨架 
Creating directories http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Creating DESCRIPTION http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Creating NAMESPACE http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... 
Creating Read-and-delete-me http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Copying code files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... 
Making help files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Done. 
Further steps are described in './sayHello/Read-and-delete-me'. 


我 们 看 到 在 当前 目录 生成 一 个 sayHello 目 录 。 


e ds zl # 查看 当前 目录 

drwxrwxr-x 4 conan conan 4096 9 月 28 09: 57 sayHello 

-rw-rw-r-- 1 conan conan 59 9 月 28 09: 48 sayHello.R- ls -1 sayHello 4 查看 sayHello 目 录 
-rw-rw-r-- 1 conan conan 281 9 月 28 09: 57 DESCRIPTION 

drwxrwxr-x 2 conan conan 4096 9 月 28 09: 57 man 

-rw-rw-r-- 1 conan conan 31 9H 28 09: 57 NAMESPACE 

drwxrwxr-x 2 conan conan 4096 29H 28 09: 57 R 

-rw-rw-r-- 1 conan conan 420 29H 28 09: 57 Read-and-delete-me- ls -1 sayHello/man 4 查看 man 目 录 
-rw-rw-r-- 1 conan conan 1043 9 月 28 09: 57 sayHello-package.Rd 

-rw-rw-r-- 1 conan conan 1278 29H 28 09: 57 sayHello.Rd- ls -l sayHello/R + 查看 R 目 录 
-rw-rw-r-- 1 conan conan 59 9 月 28 09: 57 sayHello.R 

文件 及 目录 解释 : 


: DESCRIPTION 文件 : 项 目 描述 文件 ， 用 于 设置 项 目的 全 局 的 配置 。 

|: NAMESPACE 文 件 : 项 目 命名 空间 ， 用 于 设置 项 目 输入 输出 函数 。 

- Read-and-delete-me 文 件 : 说 明文 件 ， 可 以 删除 。 

| manB e: 存放 函数 的 帮助 文件 的 目录 。 

RAR: 存放 源 代码 文件 的 目录 。 

- man/sayHello.Rd: sayHello 函 数 的 帮助 文件 ，LaTex 语 法 ， 用 来 生成 PDF 文档 。 
: man/sayHello-package.Rd: sayHello 包 的 帮助 文件 ， 可 以 删除 。 


第 四 步 ， 让 我 们 来 编辑 DESCRIPTION 文 件 ， 定 义 项 目 全 局 的 配置 。 


~ vi sayHello/DESCRIPTION 

Package: sayHello 

Type: Package 

Title: R package demo for sayHello 

Version: 1.0 

Date: 2014-09-28 

Author: Dan Zhang 

Maintainer: Dan Zhang <bsspirit@gmail.com> 
Description: This package provides a package demo 
License: GPL-3 


其 中 Package 是 项 目 名 ( 包 名 ) ; Type 是 项 目 类 型 ;Title 是 项 目标 题 ; Version 是 项 目 版 本 号 ; Date 是 项 目 创建 日 期 ; Author 是 项 目 作 者 ; Maintainer 是 主要 贡献 者 ， 可 以 多 人 ; Description 是 项 
描述 ， 建 议 多 点 的 文字 ; License 是 项 目的 发 布 协议 。 


通过 编写 DESCRIPTION 文件 ， 我 们 其 实 就 定义 了 整个 项 目的 配置 信息 。 


第 五 步 ， 编 辑 NAMESPACE 文 件 ， 用 于 设置 项 目 中 函数 输入 和 输出 。 


~ vi sayHello/NAMESPACE 
export (sayHello) 


我 们 项 目 里 只 有 一 个 函数 sayHello， 而 且 这 个 函数 是 对 使 用 者 开放 的 ， 那 么 只 要 一 行 定义 就 行 了 。 


第 六 步 ， 编 辑 sayHello.Rd 文 件 ， 编 写 sayHello 函 数 的 帮助 文档 ， 这 里 用 到 LaTex 的 语法 。 


~ vi sayHello/man/sayHello.Rd 
Nname ( sayHello] 
Nalias(sayHello) 
Ntitle(a sayHello function demo] 
Ndescriptiont 
a sayHello function demo 
} 
\usage{ 
sayHello (name) 
} 
\arguments{ 
\item{name} {a word} 


$ 
\details{ 
nothing 

} 

\value{ 
no return 
} 
\references{ 
nothing 

} 

\author{ 
Dan Zhang 
} 

\note{ 
nothing 


\seealso{ 

nothing 

} 

Vexamples( 
sayHello ("world") 


} 
\keyword{ sayHello } 


第 七 步 ， 删 除 可 忽略 的 文件 。 如 果 不 删 除 的 话 ，check 过 程 会 出 现 警告 。 


~ rm sayHello/Read-and-delete-me- rm sayHello/man/sayHello-package.Rd 


通过 上 面 的 7 个 步骤 ， 我 们 就 完成 了 新 建 sayHello 的 R 包 的 任务 。 


2. 对 sayHello 项 目 进 行 打包 。 


创建 好 了 一 个 R 包 项 目 ， 接 下 来 ， 我 们 需要 对 这 个 项 目 进行 打包 ， 


成 R 包 安装 文件 。 通 过 命令 安装 这 个 文件 ， 加 载 到 用 户 环境 ， 就 可 以 像 其 他 包 一 样 使 用 我 们 自己 创建 的 R 包 了 。 


我 们 切换 到 命令 行 ， 执 行 打包 的 命令 。 


R CMD build sayHello + 执行 打包 命令 

checking for file 'sayHello/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
preparing 'sayHello': ui 

checking DESCRIPTION meta-information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking for LF line-endings in source and make files 

checking for empty or unneeded directories 

building 'sayHello 1.0.tar.gz' 


+E 


打包 顺利 完成 ， 在 当前 目录 下 生成 了 sayHello 项 目的 安装 包 sayHello_1.0.tar.gz。 


= lemi # 查看 当前 目录 文件 

drwxrwxr-x 4 conan conan 4096 9 月 28 10: 34 sayHello 
-rw-r--r-- 1 conan conan 622 9 月 28 11: 01 sayHello 1.0.tar.gz 
-rw-rw-r-- 1 conan conan 59 95 28 09: 48 sayHello.R 


3. 本 地 安装 sayHello 包 


在 本 地 环境 中 安装 sayHello 包 ， 一 切 正常 。 


~ R CMD INSTALL sayHello 1.0.tar.gz # 通过 命令 行 安装 sayHello 1.0.tar.gz 

* installing to library "/home/conan/R/x86 64-pc-linux-gnu-library/3.1' 

* installing *source* package 'sayHello' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
** R 

** preparing package for lazy loading 

** help 

*** installing help indices 

** building package indices 

** testing if installed package can be loaded 

* DONE (sayHello) 


查看 R 的 安装 目录 ， 找 到 sayHello 目 录 。 


~ ls /home/conan/R/x86 64-pc-linux-gnu-library/3.1 
bitops devtools evaluate memoise RCurl | sayHello 


4. 使 用 sayHello 包 中 的 函数 


启动 R 程 序 ， 加 载 sayHello 包 ， 并 执行 sayHello 包 的 函数 。 


~R # 启动 R 程 序 
> library (sayHello) # 加 载 sayHello 包 
> sayHello ("Conan") # 执行 包 中 的 函数 
[1] "Hello Conan" 
» sayHello # 查 看 sayHel11o 函 数 系统 帮助 文档 
sayHello package: sayHello R Documentation 
a sayHello function demo 
Description: 
a sayHello function demo 
Usage: 
sayHello (name) 
Arguments: 
name: a word 
Details: 
nothing 
Value: 
no return 
Note: 
nothing 
Author (s) : 
Dan Zhang 
References: 
nothing 
See Also: 
nothing 
Examples: 
sayHello ("world") 


这 样 ， 我 们 的 包 已 经 成 功 制作 完成 ， 并 成 功 地 在 本 地 进行 安装 和 使 用 ! 


5. 检 查 R 包 


如 果 要 想 发 布 R 包 到 CRAN ， 我 们 的 工作 还 远 远 没有 完成 。R 包 在 提交 前 ， 必 须要 执行 check 检 查 ， 任 何 的 error 和 warning 都 将 导致 不 能 通过 。check 检 查 是 开发 过 程 中 最 麻烦 的 一 步 ， 几 乎 做 不 到 一 次 
就 通过 ， 所 以 大 家 要 耐心 解决 各 种 错误 。 


再 切 回 到 命令 行 ， 在 执行 check 检 查 的 过 程 中 会 生成 PDF， 而 生成 PDF 又 会 依赖 于 LaTex， 所 以 要 先 安装 LaTex 的 依赖 包 (500MB+) 。 


~ sudo apt-get install texlive-full # 安装 LaTex 


LaTex 安 装 完成 ， 再 执行 check 命 令 。 


R CMD check sayHello 1.0.tar.gz 4 执行 check 检 查 

using log directory '/home/conan/R/demo/sayHello.Rcheck' 

using R version 3.1.1 (2014-07-10) 

using platform: x86 64-pc-linux-gnu (64-bit) 

using session charset: UTF-8 

checking for file 'sayHello/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 
checking extension type http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... Package 

this is package 'sayHello' version '1.0' 

checking package namespace information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


I 


checking package dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking if this is a source package http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking if there is a namespace http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking for executable files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking for hidden files and directories http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking for portable file names http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking for sufficient/correct file permissions http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 
checking whether package 'sayHello' can be installed http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking installed package size http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking package directory http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking DESCRIPTION meta-information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking top-level files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking for left-over files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking index information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking package subdirectories http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking R files for non-ASCII characters http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking R files for syntax errors http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking whether the package can be loaded http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking whether the package can be loaded with stated dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 
checking whether the package can be unloaded cleanly http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking whether the namespace can be loaded with stated dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/ 
checking whether the namespace can be unloaded cleanly http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking loading without being on the library search path http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 
checking dependencies in R code http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking S3 generic/method consistency http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking replacement functions http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking foreign function calls http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking R code for possible problems http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking Rd files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking Rd metadata http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking Rd cross-references http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking for missing documentation entries http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking for code/documentation mismatches http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking Rd \usage sections http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking Rd contents http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking for unstated dependencies in examples http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking examples http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking PDF version of manual http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


EDIDI LC EOE EOE OE OE OE OEE EOE OEE EOE 


通过 了 check 检 查 的 R 包 ， 就 可 以 申请 提交 到 CRAN 了 。 虽 然 这 个 sayHello 例 子 比较 简单 ， 但 也 不 是 说 check 过 程 就 一 帆 风 顺 ， 可 能 会 出 现 各 种 莫名 其 妙 的 警告 和 错误 。 我 也 是 修正 了 很 多 的 小 问题 ， 才 
能 顺利 通过 check 的 检查 。 


6. 印 载 R 包 


我 们 安装 了 R 包 ， 有 了 时候 也 需要 和 卸载 ， 特 别 是 处 于 开发 状态 的 R 包 。 印 载 R 包 


实 比较 简单 ， 可 以 通过 两 种 方式 ， 一 种 是 命令 行 卸 载 ， 一 种 是 函数 卸载 。 


命令 行 卸 载 ， 执 行 如 下 命令 操作 。 


~ R CMD REMOVE sayHello + HRR 
Removing from library '/home/conan/R/x86_64-pc-linux-gnu-library/3.1'~ ls /home/conan/R/x86_64-pc-linux-gnu-library/3.1 # 查看 R 包 的 安装 目录 
bitops devtools evaluate memoise RCurl 


函数 卸载 ， 在 R 语 言 的 环境 中 用 remove.packages () 函数 来 实现 。 


> remove.packages ("sayHello") + HARRE 

Removing package from '/home/conan/R/x86_64-pc-linux-gnu-library/3.1' (as 'lib' is unspecified) 
> library (sayHello) i # 无 法 加 载 sayHello 包 

Error in library (sayHello) : there is no package called 'sayHello' 


5.12 ”RSstudio 中 开发 R 包 


上 面 的 操作 都 是 在 Linux 命 令 行 通过 vi 编辑 器 配合 完成 的 ， 对 Linux 命 令 和 vi 不 熟 的 人 会 觉得 难度 比较 大 。 我 们 还 可 以 通过 在 RStudio 中 完成 R 包 的 开发 ， 把 Linux 的 RStudio Server 的 环境 配置 好 ， 这 在 
《R 的 极 客 理想 一 一 工具 篇 》 的 1.5 节 已 经 介绍 过 。RStudio 已 经 为 我 们 准备 了 一 个 有 界面 的 编程 环境 ， 可 以 更 方便 我 们 制作 R 包 。 


1.RStudio 中 开发 R 包 


我 们 把 上 文 在 命令 行 操 作 的 过 程 ， 用 Rstudio 重 新 操作 一 遍 。 首 先 ， 在 Rstudio 中 创建 一 个 新 项 目 ， 包 名 为 sayHello2， 类 型 为 Package， 源 文件 包括 sayHello.R， 如 图 5-1 所 示 。 


Create Project 


€ Back | Create New Project 


Type: Package name: 
sayHello2 


Create package based on source files: 
-R/demo/sayHello.R | Add. | 
| Remove | 


Create project as subdirectory of: 


-/R/rstudio | Browse... 


LJ Create a git repository for this project 


(creme rect) ( Can 


5-1. 通过 RStudio 创 建 项 目 


RSstudio 会 自动 调用 package.skeleton () 函数 生成 的 项 目 文件 ， 当 然 这 些 文件 也 可 以 自己 手动 去 建 ， 如 图 5-2 所 示 。 


Files Plots Packages Help 
E New Folder | 全 | Upload ®©] Delete | 7 Rename | $ More- 
O A Home R- rstudio - sayHello2 
^ Name Size Modified 
t. 
|] .Rbuildignore 28 bytes Sep 28, 2014, 11:54 AM 
] .Rhistory 0 bytes Sep 28, 2014, 11:53 AM 
] DESCRIPTION 282 bytes Sep 28, 2014, 11:53 AM 
j man 
NAMESPACE 31 bytes Sep 28, 2014, 11:53 AM 
| R 


Read-and-delete-me 418 bytes Sep 28, 2014, 11:53 AM 
À! sayHello2.Rproj 260 bytes Sep 28, 2014, 11:54 AM 


图 5-2 RStudio 项 目 文件 目录 


2. 编 辑 项 目 描述 文件 DESCRIPTION 和 NAMESPACE 


这 里 包 名 为 sayHello2， 其 他 配置 一 样 ， 解 释 同 命令 行 操作 。 


如 下 编辑 DESCRIPTION 文件 : 


Package: sayHello2 

Type: Package 

Title: R package demo for sayHello 

Version: 1.0 

Date: 2014-09-28 

Author: Dan Zhang 

Maintainer: Dan Zhang «bsspirit68gmail.com» 
Description: This package provides a package demo 
License: GPL-3 


编辑 NAMESPACE 文 件 : 


export (sayHello) 


3 .编辑 R 程 序 代码 R/sayHello.R 


创建 sayHello.R 文 件 ， 定 义 sayHello 函 数 。 


~ vi sayHello.R 
sayHello«-function (name) ( 

print (paste ("Hello", name) ) 
l 


4 编辑 帮助 文档 many/sayHello.Rd 


同 命令 行 的 文档 。 


Nname (sayHello) 

Nalias(sayHello] 

Ntitle(a sayHello function demo] 
Ndescription( 

a sayHello function demo 

} 

Nusaget 

sayHello (name) 


Narguments 
\item{name} {a word) 


} 
\details{ 
nothing 


\value{ 

no return 

} 
\references{ 
nothing 


} 

\author{ 
Dan Zhang 
} 

\note{ 
nothing 


\seealso{ 
nothing 


} 
\examples{ 
sayHello ("world") 


} 
\keyword{ sayHello } 


5. 执 行 build 和 reload 


点 击 RStudio 的 Build 菜 单 中 的 Build&Reload 按 钮 ， 执 行 build 和 reload 过 程 ， 如 图 5-3 所 示 。 


Workspace History Build 


|? Build & Reload Check | Q& More- 
--» R CMD INSTALL --no-multiarch sayHello2 


* installing to library '/home/conan/R/x86 64-pc-linux-gnu-library/3.1? 
* installing *source* package *'sayHello2? ... 
** R 


** preparing package for lazy loading 


** help 

Narning: /home/conan/R/rstudio/sayHello2/man/sayHello2-package.Rd:32: All text must be in 
a section 

Warning: /home/conan/R/rstudio/sayHello2/man/sayHello2-package.Rd:33: All text must be in 
a section 

*** installing help indices 

** building package indices 

** testing if installed package can be loaded 

* DONE (sayHello2) 


图 5-3 ”通过 RStudio 运 行 Build&Reload 


到 ， 


E£ 


我 们 会 看 到 有 2 个 警告 是 关于 sayHello2-package.Rd 文 件 的 ， 删 除 与 打包 无 关 的 2 个 文件 ，man/sayHello2-package.Rd 和 Read-and-delete-me。 再 次 运行 Build&Reload 警 告 就 没有 了 ， 从 日 志 中 看 
sayHello2 同 时 被 安装 到 了 R 语 言 环境 中 ， 如 图 5-4 所 示 。 


Workspace History Build 


| Build & Reload Check | Qj More- 


-» R CMD INSTALL --no-multianch sayHello2 


installing to library *'/home/conan/R/x86 64-pc-linux-gnu-library/3.1* 
installing *source* package *sayHello2" ... 


* preparing package for lazy loading 

* help 

** installing help indices 

* building package indices 

* testing if installed package can be loaded 


图 5-4 ”通过 RStudio 再 次 运行 Build&Reload 


下 面 就 更 简单 了 ， 在 Console 运 行 环境 中 ， 加 载 sayHello 包 ， 并 执行 sayHello () 函数 ， 如 图 5-5 所 示 。 


> library (sayHello2) 
> sayHello ('Conan') 
[1] "Hello Conan" 

> sayHello 

> sayHello 

function (name) 


print (paste ("Hello", name) ) 


«environment: namespace: sayHello2» 


Console -/R/rstudio/sayHello2/ 之 
Type 'license()' or 'licence()' for distribution details. 


R is a collaborative project with many contributors. 

Type 'contributors()' for more information and 

'citation()' on how to cite R or R packages in publications. 
Type 'demo()' for some demos, 'help()' for on-line help, or 
'help.start()' for an HTML browser interface to help. 

Type 'q()' to quit R. 

Restarting R session... 


» library(sayHello2) 


Restarting R session... 


» library(sayHello2) 
» sayHello('Conan') 
[1] "Hello Conan" 

» ?sayHello 

> sayHello 

function (name) 


print(paste("Hello", name)) 


«environment: namespace:sayHello2» 


图 5-5 “加载 sayHello 包 ， 并 执行 函数 


6. 执 行 check 


最 后 我 们 再 测试 check 操 作 ， 在 RStudio 中 点 击 check 按 钮 执行 check 的 操作 ， 所 图 5-6 所 示 。 


Workspace 


History Build 


74 Build & Reload Check | 4d More- 


* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
* checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 


* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 


for executable files ... OK 

for hidden files and directories ... 
for portable file names ... OK 

for sufficient/correct file permissions ... OK 
whether package 'sayHello2! can be installed . 
installed package size ... OK 
package directory ... OK 
DESCRIPTION meta-information ... 
top-level files ... OK 
for left-over files ... 
index information ... OK 
package subdirectories ... 
R files for 
R files for 
whether the 
whether the 
whether the 
whether the 
whether the namespace can be unloaded cleanly ... OK 
loading without being on the library search path ... 
dependencies in R code ... OK 

S53 generic/method consistency ... 
replacement functions ... OK 
foreign function calls ... OK 

R code for possible problems ... 
Rd files ... OK 

Rd metadata ... OK 

Rd cross-references ... OK 

for missing documentation entries ... 

for code/documentation mismatches ... 

Rd Musage sections ... OK 

Rd contents ... OK 

for unstated dependencies in examples ... 
examples ... OK 

PDF version of manual ... 


OK 


OK 
OK 


OK 
non-ASCII characters ... 
syntax errors ... OK 
package can be loaded ... OK 
package can be loaded with stated dependencies ... 
package can be unloaded cleanly ... OK 


OK 


OK 


OK 


OK 


R CMD check succeeded 


5-6 ”通过 RStudio 完 成 check 操 作 


我 们 一 路 顺畅 地 完成 了 R 包 开发 的 操作 ， 基 本 就 是 点 点 鼠标 。 在 RSstudio 中 进行 R 的 开发 、 打 包 、 检 查 等 过 程 非常 方便 ，RSstudio 简 直 就 是 R 语 言 开发 的 神器 。 


namespace can be loaded with stated dependencies ... 


本 节 中 按照 R 语 言 开发 规范 介绍 了 完整 的 R 包 开发 过 程 ， 虽 然 规范 中 每 一 步 过程 都 很 清楚 ， 但 是 操作 过 于 复杂 ， 官 方 函数 支持 明显 不 够 ， 给 R 包 的 开发 带 来 了 很 多 的 困难 。 下 一 节 介绍 的 由 Hadley 
Wickham 重 新 定义 的 开发 流程 ， 可 以 帮助 我 们 更 简单 地 完整 R 包 开发 的 工作 。 


5.2 ”标准 化 R 包 开发 流程 
间 题 


有 没有 简单 的 R 包 开发 的 方法 ? 


http://blog. fens. me 


在 上 一 节 我 们 看 到 了 如 何 从 底层 按照 R 语 言 的 标准 构建 一 个 R 语 言 的 扩展 包 ， 但 实施 过 程 确实 复杂 ， 会 让 很 多 没有 编程 背景 的 R 语 言 用 户 望而却步 。 如 果 能 有 一 种 比较 简单 的 方式 简化 开发 过 程 ， 那 该 多 
好 啊 ! 我 们 是 幸运 的 ，Hadley Wickham 重 新 杭 理 出 了 一 套 R 包 开发 流程 ， 并 提供 了 多 种 辅助 函数 让 R 包 开发 更 简单 。 站 在 巨人 的 肩膀 上 ， 我 们 会 看 得 更 高 ， 走 得 更 远 。 


站 在 巨人 的 肩膀 再 来 开发 R 包 ， 就 有 3 个 武器 ， 即 devtools、roxygen2 和 testthat。 
“ devtools: 各 种 开发 小 工具 的 合集 ， 让 开发 变 得 简单 ， 非 常 实用 。 
“ toxygen2: 通过 注释 的 方式 ， 生 成 文档 ， 远 离 LaTex 的 烦恼 。 


- testthat: 单元 测试 ， 让 R 包 稳定 、 健 壮 ， 减 少 升级 的 痛 若 。 


新 标准 化 的 开发 流程 ， 按 下 面 5 个 步骤 来 实施 : 编写 功能 代码 、 调 试 程序 、 单 元 测试 、 撰 写 文档 、 程 序 打 包 。 


limi 


接 下 来 ， 我 们 整个 的 开发 过 程 ， 还 是 完全 通过 Linux 命 令 和 vi 编辑 器 配合 来 完成 ， 对 于 需要 界面 编程 的 用 户 ， 可 以 参考 5.1 节 中 的 在 RSstudio 环 境 中 开发 R 包 的 过 程 。 


本 节 的 系统 环境 是 : 
: Linux: Ubuntu Server 12.04.2 LTS 64bit 


< R: 3.1.1 x86. 64-pc-linux-gnu. (64-bit) 


主 _R 包 开发 同时 支持 Windows 7 环境 和 Linux 环 境 ， 为 了 减少 发 布 时 的 错误 ， 建 议 选择 Linux 上 开发 。 


在 安装 这 3 个 R 包 之 前 ， 需 要 先 安装 系统 的 依赖 软件 包 ， 比 如 libcurl4-openssl-dev。 


~ sudo apt-get install libcurl4-openssl-dev 


启动 R 程 序 ， 安 装 R 包 的 开发 工具 包 devtools，roxygen2，testthat。 


R + 启动 R 程 序 
install.packages ("devtools") # 安装 程序 包 
install.packages ("roxygen2") 

install.packages ("testthat") 

library (devtools) + 加 载 和 
library (roxygen2) 

library (testthat) 

search () # 查看 当前 环境 中 的 程序 包 
[1] ".GlobalEnv" "package: testthat" "package: roxygen2" 


VVVVVVVI 


[4] "package: devtools" "package: stats" "package: graphics" 
[7] "package: grDevices" "package: utils" "package: datasets" 
[10] "package: methods" "Autoloads" "package: base" 


2. 创 建 项 目 chinaWeather 


新 建 一 个 项 目 ， 命 名 为 chinaWeather。 创 建 骨 架 用 devtools 包 的 create () 函数 代替 原生 package.skeleton () 函数 。 


> setwd ("/home/conan/R") # 设置 工作 目录 
> create ("/home/conan/R/chinaWeather") # 创建 项 目 
Creating package chinaWeather in /home/conan/R 

No DESCRIPTION found. Creating with values: 

Package: chinaWeather 

Title: What the package does (one line) 

Version: 0.1 

Authors8R: "First Last «first.last(example.com» [aut, cre]" 
Description: What the package does (one paragraph) 
Depends: R (>= 3.1.1) 

License: What license is it under 

LazyData: true 

Adding RStudio project file to chinaWeather 


检查 创建 的 目录 和 文件 。 


> setwd ("/home/conan/R/chinaWeather") # 设置 项 目 目 录 
> dir () + 查看 目录 中 的 文件 
[1] "DESCRIPTION" "NAMESPACE" "RU 


3. 创 建 项 目 文件 


编辑 文件 DESCRIPTION。 


~ vi /home/conan/R/chinaWeather/DESCRIPTION 

Package: chinaWeather 

Type: Package 

Title: a visualized package for china Weather 
Version: 0.1 

AuthorsQR: "Dan Zhang «bsspiritGgmail.com» [aut, cre]" 
Description: a visualized package for china Weather 
Depends: R (>= 3.1.1) 

License: GPL-2 

LazyData: true 

Date: 2014-09-28 


新 建 R 程 序 文件 chinaWeather.R， 在 文件 中 定义 函数 filename () ， 注 释 不 能 包括 中 文 。 


~ vi /home/conan/R/chinaWeather/R/chinaWeather.R 
# define a filename from current date 
filename«-function (date-Sys.time () ) { 

paste (format (date, "$Y£m$d") , ".csv", sep-"") 
i 


这 里 我 们 定义 了 一 个 简单 的 函数 filename () ， 根 据 日 期 生成 一 个 文件 名 。 


5.2.3 ”调试 程序 


在 devtools 包 的 帮助 下 ， 开 发 过 程 中 可 以 直接 加 载 项 目 目录 到 R 的 运行 时 环境 中 ， 而 不 用 像 之 前 那样 ， 每 次 打包 后 才能 加 载运 行 。 


> load all ("/home/conan/R/chinaWeather") # 加 载 项 目 目录 
Loading chinaWeather 
» filename 4 查看 filename () 函数 
function (date-Sys.time () ) ( 
paste (format (date,  "$Y$m$d") , ".csv", sep-"") 
} 
<environment: namespace: chinaWeather> 
> filename () # 运行 filename () 函数 
[1] "20140928.csv" 
> day<-as.Date ("20110701", format-"$Y$m$d") # 传 参 并 运行 filename () 函数 


> filename (day) 
[1] "20110701.csv" 


5.24 单元 测试 


对 于 软件 项 目 来 说 ,为 保持 项 目 代码 的 健壮 性 ， 通 常 要 求 编写 单元 测试 的 代码 。 那 么 对 于 filename () 这 个 函数 如 何 进行 单元 测试 呢 ? 


创建 用 于 单元 测试 的 目录 。 


~ mkdir -p /home/conan/R/chinaWeather/inst/tests # 创建 Lests 目 录 ， 用 于 存放 单元 测试 的 文件 


新 建文 件 test.chinaWeather.R， 用 来 实现 对 chinaWeather.R 文 件 中 函数 的 单元 测试 。 我 们 需要 注意 ， 单 元 测试 文件 的 命名 以 test. 开 头 ， 加 上 源 代码 文件 的 文件 名 。 


新 建文 件 test.chinaWeather.R， 用 test_that () 函数 定义 单元 测试 的 代码 。 


~ vi /home/conan/R/chinaWeather/inst/tests/test.chinaWeather.R 
library (testthat) 
context ("filename: current of date") 
test that ("filename is current of date", { 
daystr«-paste (format (Sys.Date () , "$Y$m$d") , ".csv", sep-"") 
expect that (filename () , equals (daystr) ) 
day«-as.Date ("20110701", format-"$Y$m$d") 
expect that (filename (day) , equals ("20110701.csv") ) 
p 


运行 单元 测试 程序 。 


> source ("/home/conan/R/chinaWeather/inst/tests/test.chinaWeather.R") 
# 加 载 单元 测试 程序 
> test file ("/home/conan/R/chinaWeather/inst/tests/test.chinaWeather.R") 
* 执行 单元 测试 
filename: current of date : http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/.. 


> test dir ("/home/conan/R/chinaWeather/inst/tests/", reporter = "summary") 
# 对 目录 下 所 有 文件 的 单元 测试 
filename: current of date : http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/.. 


如 果 单元 测试 结果 是 正确 的 ， 则 没有 特别 的 显示 输出 。 我 们 增加 一 个 错误 的 case， 看 看 输出 会 有 什么 不 一 样 的 地 方 。 修 改 test.chinaWeather.R 文 件 ， 增 加 下 面 的 代码 。 


~ vi /home/conan/R/chinaWeather/inst/tests/test.chinaWeather.R 
library (testthat) 
context ("filename: current of date") 
test that ("filename is current of date", { 
daystr«-paste (format (Sys.Date () , "%Y%m%d") , ".csv", sep-"") 
expect that (filename () , equals (daystr) ) 
day«-as.Date ("20110701", format-"$Y$m$d") 
expect that (filename (day) , equals ("20110701.csv") ) 
p 
test that ("filename is current of date, bad test", ( 
day«-as.Date ("20110701", format-"$Y$m$d") 
expect that (filename (day) , equals ("20110702.csv") ) 
p 


再 次 启动 单元 测试 程序 ， 则 出 现 错误 提示 。 


> source ("/home/conan/R/chinaWeather/inst/tests/test.chinaWeather.R") 

Error: Test failed: 'filename is current of date, bad test' 

Not expected: filename (day) not equal to "20110702.csv" 

1 string mismatches: 

x[1]: "20110702.csv" 

yl1]: "20110701.csv" 

> test file ("/home/conan/R/chinaWeather/inst/tests/test.chinaWeather.R") 

filename: current of date : http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/..1 
1. Failure (8test.chinaWeather.RfK14) : filename is current of date, bad test ----- 
filename (day) not equal to "20110702.csv" 

1 string mismatches: 

x[1]: "20110702.csv" 

yl1]: "20110701.csv" 


我 们 去 掉 错误 的 单元 测试 代码 ， 继 续 下 面 的 操作 。 如 果 这 个 包 的 功能 函数 很 多 ， 测 试 代码 也 会 很 多 ， 那 么 我 们 可 能 需要 对 程序 包 进行 自动 化 测试 ， 通 过 设置 源 代码 目录 和 测试 代码 目录 ， 调 
auto test () 函数 会 扫描 两 个 目录 下 的 所 有 文件 。 


自动 化 单元 测试 代码 配置 。 


> src«-"/home/conan/R/chinaWeather/R/" 
> test«-"/home/conan/R/chinaWeather/inst/tests/" # 单元 测试 代码 目录 

> auto test (src, test) # 执行 单元 测试 

filename: current of date : http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/.. 


另外 ， 我 们 也 可 以 对 整个 包 执行 单元 测试 ， 因 为 源 文件 目录 和 测试 文件 目录 ， 在 同一 个 项 目的 位 置 是 固定 的 。 


> test ("/home/conan/R/chinaWeather") 
Testing chinaWeather 
filename: current of date : http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/.. 


这 样 我 们 就 非常 顺利 地 完成 了 单元 测试 ， 下 面 就 要 开始 撰写 帮助 文档 了 。 


5.2.5 ”撰写 文档 


上 一 节 中 介绍 ， 我 们 不 仅 要 动手 编写 基于 LaTex 格 式 的 帮助 文档 ， 而 且 文 档 和 代码 是 分 离 在 不 同文 件 的 ， 所 以 写 文档 的 难度 很 高 。 本 节 中 用 到 roxygen2 包 的 撰写 文档 ， 通 过 源 代 码 注释 的 方式 ， 生 成 
LaTex 格 式 的 帮助 文档 ， 这 种 方式 更 贴近 于 程序 员 的 思路 ， 而 且 写 注释 比 写 LaTex 要 容易 得 多 。 


编辑 源 代码 文件 : chinaWeather.R， 给 函数 增加 注释 。 


~ vi /home/conan/R/chinaWeather/R/chinaWeather.R # 编辑 文件 
#' Define a filename from current date. 


#' Gparam date input a date type 
$' Greturn character a file name 
#' Gkeywords filename 
#' Gexport 
#' Gexamples 
#' filename () 
#' filename (as.Date ("20110701", format-"£Y£m$d") ) 
filename«-function (da s.time () ) { 
paste (format (date, YS$m$d") , ".csv", sep-"") 
} 


E 


然后 通过 roxygen2 包 的 roxygenize () 函数 ， 生 成 LaTex 帮 助 文档 。 


> roxygenize ("/home/conan/R/chinaWeather") 4 用 roxygenize () 函数 ， 生 成 Latex 文 档 

First time using roxygen2 4.0. Upgrading automaticallyhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Writing NAMESPACE 

Writing filename.Rd 


查看 生成 的 LaTex 文 件 。 


~ cat /home/conan/R/chinaWeather/man/filename.Rd # 查看 说 明 帮 助 文档 文件 
$ Generated by roxygen2 (4.0.2) : do not edit by hand 
\name {filename} 

\alias{filename} 

\title{Define a filename from current date.) 

Nusaget 

filename (date - Sys.time () ) 

} 

\arguments{ 

\item{date} {input a date type} 

} 

\value{ 

character a file name 

} 

\description{ 

Define a filename from current date. 

} 

\examples{ 

filename () 

filename (as.Date ("20110701", format="\%Y\%m\%d") ) 


} 
\keyword{filename} 


fit 


虽然 注释 方式 与 原来 的 方式 相差 不 大 ， 但 是 规避 了 LaTex 的 语法 ， 终 于 能 让 我 们 能 专心 写 R 包 了 。 


526 程序 打包 


上 面 的 程序 过 程 (项 目 加 载 、 单 元 测试 、 生 成 帮助 文档 ) 还 可 以 更 简单 一 些 ， 只 需要 3 个 函数 调用 。 


> load all 


("/home/conan/R/chinaWeather") # 加 载 项 目 目录 


> test ("/home/conan/R/chinaWeather") # 执行 单元 测试 


> document 


("/home/conan/R/chinaWeather") # 生成 文档 文件 


执行 程序 检查 ， 也 是 一 个 函数 调用 就 可 以 完成 的 。 


> check ("/home/conan/R/chinaWeather") # 执行 程序 检查 

Updating chinaWeather documentation 

Loading chinaWeather 

'/usr/lib/R/bin/R' --vanilla CMD build '/home/conan/R/chinaWeather' VW 
--no-manual --no-resave-data 


checking 


checking 
checking 
checking 
building 


0x ox x ox o 


for file '/home/conan/R/chinaWeather/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


preparing 'chinaWeather': 


DESCRIPTION meta-information http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
for LF line-endings in source and make files 

for empty or unneeded directories 

'chinaWeather 0.1.tar.gz' 


/usr/lib/R/bin/R' --vanilla CMD check \ 


'/tmp/RtmpJ371sJ/chinaWeather 0.1.tar.gz' --timings 


checking 
checking 


checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
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using log directory '/tmp/RtmpJ371sJ/chinaWeather.Rcheck' 
using R version 3.1.1 (2014-07-10) 

using platform: x86 64-pc-linux-gnu (64-bit) 

using session charset: UTF-8 


for file 'chinaWeather/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 
extension type http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... Package 


this is package 'chinaWeather' version '0.1' 


package namespace information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

package dependencies http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

if this is a source package http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

if there is a namespace http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

for executable files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

for hidden files and directories http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

for portable file names http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

for sufficient/correct file permissions http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

whether package 'chinaWeather' can be installed http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
installed package size http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

package directory http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

DESCRIPTION meta-information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

top-level files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

for left-over files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

index information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

package subdirectories http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

R files for non-ASCII characters http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

R files for syntax errors http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

whether the package can be loaded http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

whether the package can be loaded with stated dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 
whether the package can be unloaded cleanly http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 
whether the namespace can be loaded with stated dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/ 
whether the namespace can be unloaded cleanly http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 


loading without being on the library search path http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
dependencies in R code http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

S3 generic/method consistency http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

replacement functions http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

foreign function calls http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

R code for possible problems http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

Rd files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


Rd metadata http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

Rd line widths http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

Rd cross-references http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

for missing documentation entries http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

for code/documentation mismatches http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

Rd Nusage sections http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

Rd contents http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

for unstated dependencies in examples http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
examples http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

PDF version of manual http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


一 切 顺 利 ， 全 部 通过 查 检 。 


5.2.7 程序 发 布 


开发 完 的 R 包 ， 如 果 愿 意 开源 给 其 他 人 使 用 ， 有 几 个 发 布 平台 供 选 择 : CRAN、RForge 和 Github。 


- CRAN 是 大 家 都 比较 3 


悉 的 ， 由 R Core 的 小 组 维护 ， 审 查 很 严格 。 


< RForge 是 另 一 个 R 项 目的 发 布 平台 。 


* Github 


通过 devtools 包 维护 的 一 个 发 布 平台 ， 适 合 个 人 发 布 ， 无 审查 。 


由 于 CRAN 和 RForge 平 台 有 各 种 审查 ， 不 允许 随便 发 布 ， 那 么 我 们 就 先 把 程序 发 布 到 Github 上 面 吧 ， 等 功能 完善 后 ， 再 申请 提交 到 CRAN 或 RForge。 把 项 目 上 传 到 Github 的 操作 ， 和 R 语 言 就 没什么 关 


系 了 。 我 们 需要 先 在 本 地 安装 git 工 具 ， 然 后 在 Github 社 区 创建 一 个 资源 库 ， 通 过 git 工 具 实 现 项 目的 上 传 。 我 在 Github 创 建 一 个 新 的 资源 库 chinaWeatherDemo， 项 目地 址 
为 https://github.com/bsspirit/chinaWeatherDemo， 如 图 5-7 所 示 。 


下 面 提交 本 地 代码 到 Github。 


~ cd /home/conan/R/chinaWeather # 进入 项 目 目 录 ~ git init # 初始 化 git 项 目 

Initialized empty Git repository in /home/conan/R/chinaWeather/.git/- git add . # 用 git 管 理 本 地 文件 ~ git commit -m 'init' # 用 git 提 交 文 
[master (root-commit) 43deae4] init 

6 files changed, 62 insertions (4) 

create mode 100644 .gitignore 

create mode 100644 DESCRIPTION 

create mode 100644 NAMESPACE 

create mode 100644 R/chinaWeather.R 

create mode 100644 inst/tests/test.chinaWeather.R 

create mode 100644 man/filename.Rd- git remote add origin https: //github.com/bsspirit/chinaWeather 


4 绑 定 本 地 库 和 github 的 远程 库 ~ git push -u origin master # 把 本 地 库 同步 远程 库 


To https: //github.com/bsspirit/chinaWeatherDemo.git 
* [new branch] master -> master 
Branch master set up to track remote branch master from origin. 


| This repository Search Explore Gist Blog Help 


bsspirit / chinaWeatherDemo 


Quick setup — if you've done this kind of thing before 


Setup in Desktop or 4 ssH | https://github.com/bsspirit/chinaWeatherDemo.git 


We recommend every repository include a README, LICENSE, and .gitignore. 


...Or create a new repository on the command line 


touch README.md 

git init 

git add README.md 

git commit -m "first commit" 

git remote add origin https://github.com/bsspirit/chinaWeatherDemo.git 
git push -u origin master 


...0r push an existing repository from the command line 


git remote add origin https://github.com/bsspirit/chinaWeatherDemo.git 
git push -u origin master 


...Or import code from another repository 


You can initialize this repository with code from a Subversion, Mercurial, or TFS project. 


Import code 


图 5-7 在 Github 上 创建 新 项 目 


这 样 代码 就 上 传 到 了 Github， 接 下 来 ， 通 过 devtools 包 可 以 非常 方便 地 把 R 语 言 项 目 从 Github 下 载 并 安装 。 


现在 我 的 chinaWeather 包 ,已 经 在 Github 上 面 发 布 了 ， 如 果 其 他 同学 想 使 用 ， 可 以 按照 下 面 的 命令 来 安装 。 


> library (devtools) # 加 载 devtools 

> install github ("bsspirit/chinaWeatherDemo") # 下 载 并 安装 chinaWeather 包 

Downloading github repo bsspirit/chinaWeatherDemo@master 

Installing chinaWeather 

'/usr/lib/R/bin/R' --vanilla CMD INSTALL V 
'/tmp/RtmpJ371sJ/devtools646348c59273/bsspirit-chinaWeatherDemo-43deae4' VW 
--library-' /home/conan/R/x86 64-pc-linux-gnu-library/3.1' --install-tests 

* installing *source* package "chinaWeather' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 

** R 

** inst 

** preparing package for lazy loading 

** help 

*** installing help indices 

** building package indices 

** testing if installed package can be loaded 

* DONE (chinaWeather) 

Reloading installed chinaWeather 


» library (chinaWeather) # 加 载 chinaWeather 包 
> filename () # 运行 filename () $% 
[1] "20140928.csv" 
> filename # 查看 帮助 文档 
filename Package: chinaWeather R Documentation 
Define a filename from current date. 
Description: 
Define a filename from current date. 
Usage: 
filename (date = Sys.time () ) 
Arguments: 
date: input a date type 
Value: 
character a file name 
Examples: 


filename () 


filename (as.Date ("20110701", format-"$Y£m$q") ) 


我 们 已 经 完成 了 开发 R 包 的 全 部 流程 ， 依 赖 于 devtools、roxygen2 和 testthat 三 个 工具 包 ， 真 是 事半功倍 ， 比 起 完全 手动 操作 高 效 很 多 ! 希望 更 多 的 朋友 ， 可 以 站 在 巨人 的 肩膀 前 行 ， 创 造 让 人 惊叹 的 
成 果 ! 


5.3 ”R 语 言 天 气 可 视 化 应 用 


问题 


如 何 用 R 语 言 做 一 个 天 气 可 视 化 的 应 用 ? 


R 语 言 天 气 可 视 化 应 


http://blog.fens.me/r-app-china-weather 
http://apps.weibo.com/chinaweatherapp 


在 很 多 人 看 来 ，R 语 言 还 只 是 个 玩具 ， 完 全 不 具备 企业 级 应 用 的 能 力 。 说 这 些 话 的 人 ， 可 能 根本 就 不 了 解 R 语 言 ， 更 不 清楚 如 何 做 企业 级 应 用 开发 。 从 我 最 早 接 触 R 语 言 时 ， 就 把 R 作 为 可 视 化 引擎 诬 入 到 
了 晒 粉 丝 的 微 博 应 用 中 ; 后 来 又 开发 了 数据 挖掘 算法 竞赛 网 站 ， 并 把 R 语 言 做 为 算法 引擎 ， 支 持 在 线 编程 及 运行 ; 我 做 的 第 三 个 R 语 言 应 用 就 是 本 节 要 给 大 家 分 享 的 每 日 中 国 天 气 微 博 应 用 ， 这 次 同样 是 把 R 
量化 投资 篇 》 


作为 可 视 化 引擎 ， 并 让 R 完 成 息 忠 、XML 文 档 解 析 及 数据 处 理 等 任务 ; 当然 ， 我 还 实现 了 第 四 个 、 第 五 个 、 第 六 个 以 R 为 核心 的 应 用 ， 都 是 量化 投资 方面 的 ， 会 在 下 一 本 书 《R 的 极 客 理想 
再 介绍 给 大 家 。 

从 我 的 使 用 经 验 来 看 ，R 语 言 已 经 具备 了 企业 级 应 用 的 能 力 ， 但 我 并 不 是 要 用 R 语 言 完 成 所 有 编程 任务 。 在 我 的 项 目 环境 中 ， 大 都 是 多 种 编程 语言 配合 使 用 的 ， 只 有 发 挥 各 自 语言 的 特性 优势 ， 才 是 未 来 
的 发 展 方向 。 


每 日 中 国 天 气 微 博 应 用 开发 ， 将 分 为 2 节 内 容 进 行 介绍 ，5.3 节 是 R 语 言 功 能 实现 ，5.4 节 是 R 包 开发 。 


53.1 项 目 介绍 


多 语言 混 编 ， 如 同 在 计算 机 领域 跨 学 科 一 样 ， 是 我 一 直 所 倡导 的 一 种 工作 模式 。 如 今 编 程 语言 百花 齐 放 ， 各 种 细 分 市 场 的 小 众 语言 如 雨后春笋 般 地 成 长 起 来 ， 比 起 通用 型 编程 语言 来 说， 这 些小 众 语言 
在 特定 的 领域 中 有 着 非常 明显 的 优势 。 比 如 统计 应 用 ， 如 果 用 Java 写 个 逻辑 回归 程序 感觉 深 不 见 底 ， 而 用 R 语 言 实现 逻辑 回归 就 是 很 平常 的 一 件 事情 。 再 比如 做 一 个 Web 网 站 ， 用 PHP 或 Nodejs 实 现 轻 而 易 
举 ， 如 果 用 Java 做 不 仅 代码 量 大 ， 而 且 程序 复杂 。 所 以 ， 对 于 一 个 应 用 来 说， 一 种 通用 的 语言 并 不 一 定 是 最 好 的 解决 方案 ， 如 果 能 实现 多 种 语言 的 结合 ， 那 么 你 做 出 来 的 应 用 可 以 很 酷 ， 很 不 一 样 ! 


对 于 本 节 要 介绍 的 “每 日 中 国 天 气 ”这 个 新 浪 微 博 应 用 ， 就 是 一 种 多 语言 混 编 的 实现 。 


这 个 项 目的 出 发 点 很 简单 ， 就 是 通过 可 视 化 技术 ， 展 示 中 国 每 个 省 份 的 天 气 情况 ， 给 准备 旅游 的 朋友 ， 提 供 一 种 出 行 的 提示 。 要 实现 这 个 应 用 ， 我 们 首先 要 列 出 需要 实现 哪些 功能 、 会 遇 到 哪些 问题 
等 。 


:天气 数据 : 数据 从 哪里 找到 ， 如 何 下 载 ， 如 何 存储 。 


“ 定时 任务 : 天 气 数据 需要 每 日 更 新 ， 图 片 需要 每 日 新 生成 。 


“ 地 图 和 天 气 可 视 化 : 要 把 中 国 行政 区 图 和 天 气 数据 结合 在 一 起 画图 ， 让 用 户 一 眼 就 能 看 明白 。 


:Web 展示 : 通过 可 视 化 技术 生成 静态 图 片 ， 然 后 发 布 到 Web 端 进行 展示 。 


CÁCERES 通过 结合 新 浪 微 博 ， 让 更 多 的 用 户 看 到 并 使 用 这 个 应 用 。 


: 用 户 交 互 : 用 户 可 以 查看 不 同日 期 、 不 同类 型 的 图 片 ， 用 户 还 可 以 通过 微 博 分 享 。 


虽然 是 个 很 小 的 应 


但 麻雀 虽 小 五 脏 俱全 ， 我 们 也 需要 完整 地 思考 如 何 才能 实现 这 个 应 用 。 


5.3.2 ”系统 架构 设计 


从 上 面 的 功能 描述 中 可 以 看 出 ， 单 独 使 用 一 种 语言 也 可 以 开发 。 如 果 单独 用 PHP 开 发 ， 做 一 个 Web 网 站 非常 容易 ， 连 接 新 浪 微 博 也 有 现成 的 SDK 可 以 调用 ， 怜 取 数 据 及 存储 也 不 麻烦 ， 那 么 如 何 实现 地 
加 和 天 气 数据 的 可 视 化 ， 似 乎 就 很 困难 了 。 如 果 单独 用 R 开 发 ， 候 取 数 据 及 存储 同样 很 容易 实现 ， 地 图 和 天 气 数据 的 可 视 化 也 是 很 方便 就 能 画 出 来 ， 但 是 用 R 做 Web 网 站 ， 那 就 会 遇 到 很 大 的 瓶颈 了 ， 因 为 R 
是 单线 程 同步 的 计算 模型 ，Web 应 用 的 高 并 发 特点 ， 会 直接 让 R 程 序 骨 演 的 。 所 以 ， 综 合 上 面 的 问题 ， 如 果 R 语 言 和 PHP 语 言 能 结合 在 一 起 使 用 ， 不 仅 能 名 开 每 种 语言 不 擅长 的 地 方 ， 还 能 让 每 种 语言 在 擅长 
的 领域 发 挥 优势 ， 我 们 将 通过 多 语言 的 混 编 技术 做 出 很 不 一 样 的 应 用 来 。 


为 了 实现 应 用 的 功能 需求 ， 我 们 要 设计 一 套 系统 架构 ， 如 图 5-8 所 示 。 


新 浪 微 博 服务 Web 应 用 服务 器 


生成 图 片 


图 5-8 简单 系统 架构 
上 面 的 系统 架构 解释 如 下 : 
“ 通过 定时 器 启动 爬虫 程序 ， 到 Yahoo 的 天 气 数据 源 下 载 数据 。 


“ 爬虫 下 载 数 据 到 本 地 服务 器 进行 解析 ， 存 储 应 用 相关 的 数据 到 CSV 文 件 。 


:可视化 程序 ， 读 入 天 气 数据 及 地 图 数据 ， 生 成 静态 的 图 片 作为 可 视 化 输出 。 


“ 最 终 用 户 通过 新 浪 微 博 ， 加 载 Web 应 用 ， 看 到 了 可 视 化 生成 的 静态 图 片 。 


“ 最 终 用 户 通过 新 浪 微 博 分 享 了 这 个 应 用 ， 让 更 多 的 人 看 到 这 个 应 用 。 


下 面 按照 语言 的 优势 ， 把 应 用 架构 按 语言 的 特性 来 划分 ， 让 R 语 言 实 现 息 虫 、 处 理 数据 和 可 视 化 ， 让 PHP 完 成 Web 开 发 、 新 浪 API 接 入 和 用 户 交互 ， 如 图 5-9 所 示 。 


用 户 访问 


通过 语言 的 划分 ， 就 可 以 扬长 避 短 ， 让 每 科 


Ki 


; 接 下 来 ， 再 


Web 应 用 


SS 


新 浪 微 情 服务 服务 器 


DE Ed 
保存 数据 到 本 地 
生成 静态 图 片 


Yahoo 天 气 数 据 源 数据 处 理 
后 台 任 务 
图 5-9 语言 优势 的 系统 架构 


由 于 这 个 应 


不 需要 让 R 和 PHP 直 接 进 行 通 信 ， 那 么 复杂 度 就 小 很 多 ， 像 我 之 前 做 的 晒 粉丝 应 


语言 在 最 擅长 的 领域 ， 完 成 最 擅长 的 事情 。 


对 于 后 台 技术 应 


， 定 时 器 可 以 


通过 R 语 言 


Linux 系 统 的 CRON 实 现 ;然后 用 R 语 言 程序 来 胞 取 数 据 ， 通 过 RCurl 包 来 完成 ， 息 取 后 的 数据 为 XML 格 式 ，1 


R 语 言 处 理 数据 ， 力 


对 于 前 端的 PHP 应 


合理 的 架构 设计 加 上 适当 的 语言 分 工 ， 就 能 轻松 实现 “每 日 中 国 天 气 ” 这 样 的 一 个 微 博 应 


大 多 数 程序 员 都 是 在 
实现 所 有 的 功能 。 


我 承认 Java 是 一 种 无 所 不 能 的 编程 语言 ， 但 是 如 果 你 所 有 的 程序 都 
因 。 其 实 ， 在 精通 一 门 语言 后 ， 再 去 学 习 另 外 一 门 新 的 语言 ， 就 不 是 那么 难 了 。 但 如 果 只 是 沉醉 于 已 掌握 的 技术 ， 很 快 就 会 被 一 代 新 人 、 一 代 新 工具 所 超越 的 。 


来 说 ， 


5.333 ”R 语 言 程序 实现 


下 面 就 开始 介绍 R 语 言 的 部 分 程序 开发 ， 在 写 代码 之 前 ， 


REEE 


来 说 明 程序 之 间 的 调 


PHP 做 一 个 Web 网 站 很 简单 ， 使 F 
， 让 Nginx 完 成 负载 均衡 和 图 片 加 载 ， 并 配合 PHP 的 访问 规则 ， 实 


自己 的 技术 领域 中 游 思 有余， 只 是 在 掌握 了 一 种 语言 的 核心 技术 并 有 了 一 些 开发 经 验 后 ， 
这 些 也 都 是 有 理想 的 程序 员 ， 只 不 过 他 们 进入 了 一 个 误 


[0 载 地 图 包 ggmap、mapdata、maptools， 最 后 配合 plot () 函数 实现 图 片 的 输出 ， 保 存在 本 地 服务 器 上 。 


YI 快速 开发 框架 ;用 PHP 
钢 功 能 的 切换 。 


的 新 浪 微 博 SDK 进 行 API 操 作 ， 实 现 新 浪 登陆 、 新 浪 分 享 等 功能 ; 


， 是 3 种 语言 (R、PHP 和 Java) 的 结合 。 通 过 Java 实 现 中间 程序 的 调度 ， 让 R 和 PHP 能 够 实现 通信 。 我 们 


XML 包 进行 解析 ， 以 CSV 格 式 进行 本 地 存 


最 后 Nginx+Spawn 构 建 4 


。 其 实 ,我 们 可 以 


这 种 多 语言 混搭 的 方式 ， 创 建 出 各 种 创新 型 的 网 站 应 


往往 不 愿意 再 去 学 第 二 种 语言 。 对 这 些 人 来 说 ， 总 觉得 
区 ， 被 现 有 的 技术 给 迷 住 了 ， 看 不 到 、 也 不 愿意 看 到 外 面 的 世界 已 经 变 了 。 我 曾经 就 是 这 样 的 ! 


自己 就 是 世界 的 中 心 ， 


HPHP 运 行 时 环 


， 但 前 提 是 先 能 掌握 多 种 语言 。 


自己 有 能 


而 专 有 领域 的 应 


ava 实 现 ， 难 道 不 觉得 费时 又 费力 吗 ? 通 


性 越 强 ， 


我 们 需要 先 梳理 开发 流程 并 做 程序 设计 ，R 语 言 都 需要 实现 哪些 功能 ， 


到 哪些 第 三 方 R 包 。 


。 这 也 是 我 从 


ava 单 一 的 技术 路 线 走 出 来 的 原 


加 载 、 数 据 可 视 化 处 理 、 生 成 静态 医 


关系 ，R 语 言 的 程序 实现 一 共 包 括 了 6 个 部 分 ， 即 息 虫 程序 、 本 地 存储 、 地 


、 生 成 可 交互 的 静态 图 ， 


如 图 5-10 所 示 。 


Rcurl, XML 


Yahoo 天 气 数 据 源 


本 地 存储 程序 


write. csv() 


maps, mapdata, maptools 


RColorBrewer 


plot () 生成 静态 图 片 echarts 


图 5-10 ”RR 语言 程序 设计 


在 图 5-10 中 ， 分 别 标 出 了 每 个 步骤 用 到 的 R 包 或 者 功能 函数 ， 同 时 我 们 可 以 按照 这 个 流程 来 定义 功能 函数 ， 这 样 我 们 就 把 整个 应 用 程序 都 规划 好 ， 最 后 再 对 应 地 写 代码 就 不 难 了 。 


1. 怜 虫 部 分 


对 于 有 拒 虫 部 分 来 说 ， 就 是 定时 下 载 每 个 城市 的 或 地 区 的 天 气 数 据 ， 并 解析 数据 ， 只 保留 我 们 需要 的 字段 ， 并 以 CSV 的 格式 存储 。 互 联网 上 有 很 多 免费 公开 的 天 气 数据 源 ， 对 我 来 说 ， 最 方便 的 数据 源 有 2 
， 一 个 是 Yahoo 的 天 气 数 据 ， 另 一 个 是 Google 的 天 气 数 据 ， 但 由 于 Google 的 API 从 中 国 大 陆 会 经 常 访问 不 到 ， 所 以 我 在 这 里 选择 Yahoo 的 天 气 数据 源 进行 访问 。 


Yahoo 天 气 数据 源 的 访问 地 址 ， 如 下 所 示 。 


http://weather.yahooapis.com/forecastrssw-WOEID 


其 中 WOEID 代 表 城 市 对 应 的 代码 ， 北 京 对 应 的 WOEID 为 2151330， 如 果 想 查看 北京 的 天 气 数据 ， 可 以 用 浏览 器 访问 http://weather.yahooapis.com/forecastrssw=2151330。 


我 们 通过 浏览 器 打开 地 址 ， 就 可 以 看 到 这 个 数据 ， 数 据 是 以 XML 格 式 进行 发 布 的 ， 如 图 5-11 所 示 。 


» Q [|jweather.yahooapis.com/forecastrss?w- 2151330 
m 应 用 CJ] 应 用 Google 


This XML file does not appear to have any style information associated with it. The 
document trec is shown below. 


virss xmnlns; yweather=" http z//xml, veather. yahoo. cam/ns/ css/ 1. 0" 
xnlns:gceo-" http://www. v3. org/2003/01/geo/wgs84 post" versiore 2.07? 
v schannel? 
«title»Tahoo! Weather — Beijing, </title> 
vlink> 
http: /us. rd. yahoo. com/dailymews/rss/weather/Beijing  CMx*http://weather. yakoo. con forecast /CHIAIOCOS 
link? 
£descriptioro Yahoo! Weather for Beijing, Cl«/descripticro 
4language?er-us4/languags^ 
<last FuildDate Wed, 01 Oct 2014 11:00 an CST4/lastBuildDate^ 
&ttl»50C ttl» 
Cywyeather:location city-"Beijing" reziore " coat cy=° China” > 
Xyweather:urits tenperature-'F^ distance-^ni" pressure-"ir' speed-"mph' /? 
&yweather:wind chill-"59" directicn-" 320" speed=" 2" /> 
&yweather:ztmosphere kumidity-^ 59" wisibility-' 2. 55° pressuare-^ 
£wweather:astronony sunrise-/B:10 am simset-^5:58 Im > 


^ 


risinz-' ff /5 


Image 
<title> Yakoo! Veatherc/title? 


Zwi dt lo 1424 / width? 
4hoight?l&4/hoi ght? 
Clink)bttp: // weather. yahoo. conz/link) 
v &url? 
httpi//1l. yimg.con/z/i/brand/purplelogu//uh/us/newz-wea gif 
</url? 
&fimage? 
vAten? 
Ctitle»Corditions for Beijing, CM at 11:00 am CST title» 
geo: lat52H. 91</geo:lat> 
“gen! long?118. 384/geo:long? 
v Zlink^ 
http://us. rd yahoo. com dailynews/rss/vezther/8eijing | CNÁshttpi//weather. yahoo., con/ forecast /CHRRDO 


(img sræ”http:// L yimg.com/a/i/us/we/52/21.gif"/2Xbr /> «boCurrent Conditions:&/b24br /> Haze, 
59 F«FR > BR /54boKnrecasttc/bo4BE /> Wed - Showers. High: 56 Low: dg<br /» Thu — Sumny. High: 
72 Low: 53i£br /> Fri - AM Sbowers. High: 951 Lov: Abr /> Sat 一 Showers. High: 61 Low: 52£br /> 
Sm — AM Shoverz. High: 66 Low: 4bZbr /> br /? <a 

href-"http: //uz. rd. yahoo. con//dailynewz/rsz/weatker/Baijing | CN *http://weather. yahoc con forecas 
Forecast at Yahoo! Weatherd/a <BR? HRY (provided by <a href=" http://www. weather.com” ?The 
Vezther Chamel ta) <br/>) 


5-11 北京 的 天 气 数据 


我 们 要 解析 这 个 XML 文件 ， 从 中 找到 我 们 需要 的 数据 进行 提取 。 在 R 语 言 中 ， 通 过 RCur| 包 实现 HTTP 的 网 络 访问 ， 抓 取 到 整个 的 XML 文档 数据 ， 然 后 通过 XML 包 解 析 XML 文 档 的 DOM 树 ， 就 能 找到 我 
们 需要 的 数据 了 。 


本 节 的 系统 环境 是 : 
* Windows 7 64bit 
- R: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 


当 我 们 把 业务 逻辑 和 技术 实现 都 想 清楚 了 ， 就 可 以 动手 写 代 码 了 ， 只 十 几 行 代码 就 能 完成 他 虫 和 XML 文 档 解析 的 功能 。 


> library (RCurl) t 加 载 类 库 
> library (XML) 


> 

> getWeather<-function (x) { 

url<-paste ('http: //weather.yahooapis.com/forecastrssw=', x, '&u=c', sep="") 
# yahoo 的 数据 源 地 址 


十 


* doc = xmlTreeParse (getURL (url) , useInternal = TRUE) # 解析 XML 文档 

十 

十 ans«-getNodeSet (doc, "//yweather: atmosphere") 

* humidity«-as.numeric (sapply (ans, xmlGetAttr, "humidity") ) # 温度 

十 visibility«-as.numeric (sapply (ans, xmlGetAttr, "visibility") ) # 能 见 度 
十 pressure<-as.numeric (sapply (ans, xmlGetAttr, "pressure") ) 基 气压 

* rising«-as.numeric (sapply (ans, xmlGetAttr, "rising") ) # 气压 变动 
$ 

+ 

+ 


ans<-getNodeSet (doc, "//item/yweather: condition") 
code<-sapply (ans, xmlGetAttr, "code") # 天 气 情况 


EN 
十 ans«-getNodeSet (doc, "//item/yweather: forecast[1]") 

E low«-as.numeric (sapply (ans, xmlGetAttr, "low") ) # 最 高 气温 

* high«-as.numeric (sapply (ans, xmlGetAttr,  "high") ) # 最 低 气温 

n 

* print (paste (x, '==>', low, high, code, humidity, visibility, pressure, rising) ) 
+ cbind (low, high, code, humidity, visibility, pressure, rising) 


# 以 data.frame 格 式 返回 


运行 程序 ， 查 看 返回 的 结果 。 


w«-getWeather (2151330) 

] "2151330 ==> 9 13 21 59 4.1 1016.4 0" 

w # 返回 的 结果 集 
low high code humidity visibility pressure rising 
"Q" "j3" "21" "59" "4.1" "1016.4" "O" 


> # o gdpeddgm 
[1 
> 


n, 1 


对 于 功能 需求 来 说， 一 个 城市 只 保存 7 个 字段 就 行 了 ， 其 他 的 XML 文档 的 数据 可 以 全 部 过 滤 掉 不 管 。 


2. 本 地 存储 


我 们 通过 拒 虫 下 载 并 过 滤 后 的 数据 ， 已 经 是 data.frame 的 格式 了 ， 通 过 write.csv() 函数 就 把 这 些 数 据 输出 到 本 地 文件 系统 中 保存 起 来 ， 作 为 数据 的 备份 。 


我 们 在 处 理 本 地 存储 的 过 程 中 ， 除 了 要 生成 一 个 CSV 文 件 ， 还 包括 了 文件 命名 以 及 把 多 个 城市 的 数据 合并 到 一 个 文件 存储 的 问题 。 下 


命名 ，loadDate () 函数 用 于 多 个 城 


数据 的 加 载 ， 合 并 在 一 个 文件 中 保存 。 


I 


城市 列表 应 该 是 我 们 需要 提前 准备 好 的 ， 我 这 里 只 选取 了 中 国 的 34 个 城市 作为 我 们 要 获得 的 城市 天 气 数据 的 信息 。 如 果 想 怜 取 更 多 的 


件 WOEID.csv: 


城市 天 气 数据 的 信息 ， 那 么 补充 这 个 列表 就 行 了 。 城 市 列表 数 拉 


我 们 需要 再 定义 两 个 函数 ，filename () 函数 用 于 新 生成 文件 的 


beijing，2151330， 北 京 ， 北 京 市 ，116.4666667，39.9 
shanghai，2151849， 上 海 ， 上 海 市 ，121.4833333，31.23333333 
tianjin，2159908， 天 津 ， 天 津 市 ，117.1833333，39.15 
chongqing，20070171， 重 庆 ， 重 庆 市 ，106.5333333，29.53333333 
harbin，2141166， 哈 尔 滨 ， 黑 龙 江 省 ，126.6833333，45.75 
changchun，2137321， 长 者， 吉林 省 ，125.3166667，43.86666667 
shenyang，2148332， 沈 阳 ， 过 宁 省 ，123.4，41 .83333333 
hohhot，2149760， 呼 和 浩特 ， 内 蒙古 自治 区 ，111.8，40.81666667 
shijiazhuang, 2171287, 石家庄， 河北 省 ，114.4666667，38.03333333 
wulumuqi，26198317， 乌 鲁 木 齐 ， 新 疆 维吾尔 自治 区 ，87.6，43.8 
lanzhou，2145605， 兰 州 ， 甘 肃 省 ，103.8166667，36.05 
xining，2138941， 西 宁 ， 青 海 省 ，101.75，36.63333333 
xian，2157249， 西 安 ， 陕西 省 ，108.9，34.26666667 
yinchuan，2150551， 银 川 ， 宁 夏 回 族 自治 区 ，106.2666667，38.33333333 
zhengzhou，2172736， 郑 州 ， 河 南 省 ，113.7，34.8 

jinan，2168327， 济 南 ， 山 东 省 ，117，36.63333333 
taiyuan，2154547， 太 原 ， 山 西 省 ，112.5666667，37.86666667 
hefei，2127866， 合 肥 ， 安 徽 省 ，117.3，31.85 

wuhan，2163866， 武 汉 ， 湖 北 省 ，114.35，30.61666667 

changsha, 26198213, Ki}, 344i, 113, 28.18333333 

nanjing, 2137081, fp, ir3/4, 118.8333333, 32.03333333 
chengdu, 2158433, JA, vj, 104.0833333, 30.65 

guiyang, 2146703, $m, #74, 106.7, 26.58333333 

kunming, 2160693, i9], zi, 102.6833333, 25 

nanning, 2166473, WF, | 7itiküi6IX, 108.3333333, 22.8 

lasa, 26198235, 41}, Wi E56 IR, 91.16666667, 29.66666667 
hangzhou, 2132574, 4i, #it#, 120.15, 30.23333333 

nanchang, 26198151, &j E, X144, 115.8666667, 28.68333333 
guangzhou, 2161838, >, j^ 4/8, 113.25, 23.13333333 

fuzhou, 2139963, 4&l, j&sb-, 119.3, 26.08333333 

taipei, 2306179, 台北， 台湾 省 ，121.5166667，25.05 
haikou，2162779， 海 口 ， 海 南 省 ，110.3333333，20.03333333 
hongkong，24865698， 香 港 ， 香 港 特别 行政 区 ，114.1666667，22.3 
macau，20070017， 澳 门 ， 澳 门 特别 行政 区 ，113.5，22.2 


字段 解释 如 下 : 

“ 第 一 列 ， 城 市 的 英文 名 
第 二 列 ，WOEID 代 码 

“ 第 三 列 ， 城 市 的 中 文 名 

“ 第 四 列 ， 城 市 所 在 的 省 中 文 名 
第 五 列 ， 经 度 〈 默 认为 东经 ) 
第 六 列 ， 纬 度 〈 默 认为 北纬 ) 


于 生成 数据 文件 的 R 语 言 的 函数 实现 如 下 : 


> filename<-function (date-Sys.time () ) { # 文件 根据 日 期 来 命名 
* paste (format (date,  "$Y$m$d") , ".csv", sep-"") 
+} 
> loadDate<-function (date) { # 读 取 城 市 列表 ， 调 用 爬虫 函数 ， 合 并 数据 保存 到 一 个 文件 中 。 
十 print (paste ('Date', '==>', date) ) 
十 city«-read.csv (file-"WOEID.csv", header-FALSE, fileEncoding-"utf-8", 
# 加 载 城市 列表 
* names (city) «-c ("en", "woeid", "zh", 'prov', 'long', 'lat') 
十 city«-city[-nrow (city) , ] 
+ 
+ wdata<-do.call (rbind, lapply (city$woeid, getWeather) ) 
+ w<-cbind (city, wdata) 
+ write.csv (w, file=filename (date) , row.names=FALSE, fileEncoding="utf-8") 
+} 


encoding="utf-8") 


运行 程序 的 loadDate () 函数 ， 程 序 会 根据 城市 列表 的 数据 调用 getWeather () 函数 自动 估 取 我 们 定义 的 所 有 城市 的 天 气 数据 。 


date-Sys.time () ; date 4 选择 日 期 
1] "2014-10-01 13: 01: 08 CST" 
oadDate (date) + 已 取 数据 
"Date ==> 2014-10-01 13: 01: 08" 
"2151330 ==> 9 13 21 59 4.1 1016.4 0" 
"2151849 » 18 23 30 57 9.99 1015.92 0" 
> 12 22 30 58 9.99 1017 0" 


"20070171 一 > 16 22 26 79 NA 1013.6 0" 
"2141166 ==> 2 13 34 29 9.99 1015.92 0" 
"2137321 —2 3 6 11 81 9.99 1015.92 1" 
"2148332 > 7 16 34 27 9.99 1015.92 0" 


1 
a 
1 
1 
1 
] "2159908 
1 
1 
1 
1 
] "2149760 ==> 4 19 30 59 9.99 982.05 0" 


"2171287 = 
"26198317 


12 14 11 94 2.49 982.05 2" 
> 12 23 34 52 9.99 1015.92 2" 


"2145605 6 17 20 82 8 812.73 0" 
"2138941 3 21 32 63 9 745.01 0" 
"2157249 13 23 11 91 2.99 1017.9 0" 
"2150551 8 22 28 60 7 1016.8 0" 
"2172736 13 19 32 52 8 1015.92 0" 
"2168327 14 22 32 49 NA 1017 0" 
"2154547 9 18 20 88 1.59 982.05 2" 
"2127866 17 23 34 60 9.99 1015.92 2" 
"2163866 19 26 28 78 6 982.05 2" 
"26198213 一 > 21 28 28 65 9.99 982.05 2" 
"2137081 一 > 15 23 34 57 9.99 1015.92 2" 
"2158433 19 27 20 69 4.01 1015.92 0" 


"2146703 18 26 28 73 9.99 1015.92 0" 
"2160693 13 23 28 64 9.99 1015.92 2" 
"2166473 一 > 24 32 30 62 9.99 982.05 0" 


"26198235 ==> -1 15 30 50 NA 643.41 0" 
"2132574 16 23 30 53 9.99 1015.92 0" 
"26198151 一 > 21 27 20 75 7 1016.4 0" 
"2161838 25 31 28 58 8 982.05 2" 


"2139963 
"2306179 
"2162779 
"24865698 


21 29 28 65 9.99 982.05 0" 
24 28 28 70 9.99 982.05 0" 
24 31 30 58 9.99 982.05 0" 
> 26 30 30 59 9.99 982.05 2" 


|HBHBHBHHHHHHHíBHHHHHHHHBHHmBpHHHB 


程序 运行 完成 后 ， 会 在 当前 目录 生成 一 个 名 字 为 20141001.csv 的 文件 。 打 开 20141001.csv 文 件 ， 这 个 文件 就 是 接 下 来 用 于 生成 可 视 化 图 片 的 基础 数据 了 。 


"en", "woeid", "zh", "prov", "long", "lat", "low", "high", "code", "humidity", "visibility", 
"pressure", "rising" 

"beijing", 2151330, "3b", "ib , 116.4666667, 39,9, "9", "13", "21", "59", "4.1", "1016,47, "0" 

"shanghai", 2151849, "E", "EW", 121.4833333, 31.23333333, "18", "23", "30", "57", "9.99", 
"1015.92", "0" 

"tianjin", 2159908, "X;t", "Xi", 117.1833333, 39.15, "12", "22", " 

"chongqing", 20070171, "€ A", "$i", 106.5333333, 29.53333333, "16 
"1013.6", "0" 

"harbin", 2141166, "RÆ", "RIE", 126.6833333, 45.75, "2", "13", "34", "29", "9.99", 
"1015.92", "0" 

"changchun", 2137321, "KÆ", "E45", 125.3166667, 43.86666667, 
"1015.92", "1" 

"shenyang", 2148332 

"hohhot", 2149760, 
"982.05", "O" 

"shijiazhuang", 2171287, "AÈ", "jp4t4", 114.4666667, 38.03333333, "12", "14", "11", "94", 
"2,49", "982.05", "2" 

"wulumugi", 26198317, "f 4pk;p", "HEERA", 87.6, 43.8, "12", "23", "34", "52", "9.99", 
"1015.92", "2" 

"lanzhou", 2145605, "ZW", "AJ", 103.8166667, 36.05, "6", "17", "20", "82", "B8", "812.73", "0" 

"xining", 2138941, "d'y", "Ad", 101.75, 36.63333333, "3", "21", "32", "63", "9", "745.01", "0 

azian”, 2157249, "jj", "RAJ", 108.9, 34.26666667, "13", "23", "11", "91", "2.99", "1017.9", "0" 

"yinchuan", 2150551, "4l", "TX Ek Éi6 IX", 106.2666667, 38.33333333, "8", "22", "28", "60", 
"7", "1016.8", " 

"zhengzhou", 2172736, "郑州 "， 

"jinan", 2168327, "HAT, " 

"taiyuan", 2154547, "太原 "， 
"982.05", "2" 

"hefei", 2127866, "4E", "del", 117.3, 31.85, "17", "23", "34", "60", "9.99", "1015.92", "2 

"wuhan", 2163866, "Xx", "湖北 114.35, 30.61666667, "19", "26", "28", "78" Ei "982.05", 

"Cchangsha", 26198213, "Ky", "4&5", 113, 28.18333333, "21", "28", "28", "65", 

"nanjing", 2137081, "jx", "irj", 118.8333333, 32.03333333, "15", "23", "34", 
"1015.92", "2" 

"chengdu", 2158433, "RAR", 


, "79", NA, 


, "6", "11", "B1", "9.99", 


Tu", mẹ", 123.4, 41.83333333, "7", "16", "34", "27", "9,99", "1015.92", "O" 
s "RÉF HE", 111.8, 40.81666667, "4", "19", "30", "59", "9.99", 


dU, 113.7, 34.8, "13", "19", "32", "52", "g", "1015,92", "O" 
LH", 117, 36.63333333, "14", "22", "32", "49", NA, "1017", "0 
igi", 112.5666667, 37.86666667, "18", "20", "88", "1.59", 


9 


. 104.0833333, 30.65, "19", "27", "20", "G9", "4.01", "1015.92", "0" 
"guiyang", 2146703, "3tfa", | 106.7, 26.58333333, "18"; " ? u73" "9199", "1015.92". "O" 
"kunming", 2160693, "RA", "AmA", 102.6833333, 25, "13", "23" 64", "9.99", "1015.92" 
"nanning", 2166473, "Arp", "J Sibi iG EL", 108.3333333, 22.8, "24", "32", "30", "62", "9.99", 
"982.05", "O" 
"lasa", 26198235, "拉萨 " 
"hangzhou", 2132574, "ji 
"1015.92", "O" 
"nanchang", 26198151, "H5", "iriS/i", 115.8666667, 28.68333333, "21", "27", "20", "75", "7", 
"1016.4", "O" 
"guangzhou", 2161838, ">M", "J- Ab", 113.25, 23.13333333, "25", "31" 
T Adi", 119.3, 26.08333333, "21", "29", " 
EA", 121.5166667, 25.05, "24", "28", "28 
海南 省 "， 110.3333333, 20.03333333, "24", "31", 


"HAE", 91.16666667, 29.66666667, "-1", "15", "30" 
indi", 120.15, 30.23333333, "16", "23", "30", "53 


"50", NA, "643.41", "O" 
"9,99", 


"28", "5g", "B", "982.05", 
, "9.99", "982.05", 
? "ol99" "982.05" "O" 
. "sg", "9.99", 


"taipei", 2306179, 
"haikou", 2162779, "iu", 


"982.05", "Q" 
24865698, "4k", "AARIKE", 114.1666667, 22.3, "26", "30", "30", "59", "9.99", 
4982.05", "2" 


数据 一 共有 10 列 ， 字 段 解释 如 下 : 

“ en， 城 市 英文 名 

* woeid，Yahoo 天 气 API 定 义 的 WOEID， 用 于 匹配 城市 
: zh， 城 市 中 文 名 

prov， 城 市 所 在 省 的 中 文 名 

“ long， 经 度 ( 中 国 处 于 东经 ， 不 区 别 东经 西 经 ) 
“ lat， 纬 度 ( 中 国 处 于 北纬 ， 不 区 别 南 纬 北纬 ) 

“ low， 最低 温度 

“ high， 最 高 温度 

| code， 天 气概 括 代 码 

“humidity， 湿 度 

- visibility, 4e LÆ 

“pressure， 大 气压 


“rising， 气 压 变 动 


这 样 数据 就 准备 好 了 ， 那 么 接 下 来 就 可 以 把 天 气 数据 对 应 到 中 国 行政 区 地 图 上 了 。 


3. 中 国 地 国 加 载 


R 语 言 通过 第 三 方 的 地 | 


IR] 


R 包 ， 可 以 很 方便 地 实现 基于 地 图 的 可 视 化 或 基于 地 理 信息 的 数据 处 理 。 那 么 R 语 言 是 如 何 做 到 的 呢 ， 答 案 是 通过 maps、mapdata、maptools 这 3 个 包 合作 完成 的 。 


我 们 调 


mapd 


ata 


maptools&fSreadShapePoly () 函数 ， 加 载 中 国 行政 区 地 图 的 数据 信息 ， 保 存在 map 的 变量 中 ， 直 接 
录 中 ， 一 共有 3 个 文件 ， 即 bou2_4p.dbf、bou2 4p.shp 和 bou2_4p.shx。 


plot () 函数 就 可 以 看 到 可 视 化 的 效果 了 。 站 地 图 数据 是 我 提前 下 载 好 的 ， 保 存放 在 


VVVVN 


library (maps) 
library (mapdata) 
library (maptools) 
map«-readShapePoly 
plot (map) 


('mapdata/bou2 4p.shp') # 加 载 中 国 行政 区 地 图 数据 
# 画 出 中 国 行政 区 图 


很 神奇 ，2 行 就 画 出 中 国 行政 区 地 图 的 轮廓 。 我 们 再 继续 来 分 析 map 这 个 变量 。 先 检查 一 下 的 map 的 类 型 ， 发 现 是 sp 包 中 定义 的 SpatialPolygonsDataFrame 类 型 的 。 


> 
[1 
at 
[1 


class (map) 


+ 查看 map 对 象 类 型 


] "SpatialPolygonsDataFrame" 


tr (, "package") 
] "sp" 


SpatialPolygonsDataFrame 类 型 我 们 并 不 熟悉 ， 再 用 pryr 包 的 otype 查 检 一 下 面向 对 象 系统 的 类 型 。 


多 
> 
[1 


library (pryr) 
otype (map) 
] "s4" 


# 发 现 是 S4 类 型 的 data.frame 


之 前 4.4 节 中 ， 我 们 已 经 掌握 了 S4 类 型 的 基础 知识 ， 在 知道 map 是 S4 类 型 的 实例 后 ， 大 概 就 能 猜 出 这 个 对 象 如 何 使 用 了 。 另 外 从 命名 上 看 ，SpatialPolygonsDataFrame 类 型 应 该 是 用 data.frame 存 储 
了 SpatialPolygons 类 型 的 数据 。 先 通过 length () 函数 和 names () 函数 ， 从 data.frame 的 角度 查看 map 对 象 ， 包 括 7 列 925 行 。 


length (map) # 一 共有 925 条 记录 

] 925 

names (map) 3 data.frame 包 括 有 7 列 

] "AREA" "PERIMETER" "BOU2 4M " "BOU2 4M ID" "ADCODE93" 
] "ADCODE99" "NAME" 


再 通过 str () 函数 查看 map 对 象 第 一 行 数 据 的 静态 结构 。 


= 


str (map[1, ]) 


Formal class 'SpatialPolygonsDataFrame' [package "sp"] with 5 slots 
http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/0EBPS/Text/ 


http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 


http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/OEBPS/Text/ 


http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/0EBPS/Text/.. 
http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/0EBPS/Text/.. 
http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/0EBPS/Text/.. 
http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 
http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/0EBPS/Text/.. 
http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 
http://www.hzcourse.com/resource/readBook?path=/openresources/teach ebook/uncompressed/15294/OEBPS/Text/. . 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 
http: / /www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/. . 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text./ . . 


http://www .hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text./ 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/ 


http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/. . 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/. . 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 


http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/ 


http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text./ . . 


..8 data 


'data.frame': 1 obs. of 1 variable: 


http: //www.hzcourse.com/resource/readBook?path-/openresources/teact. 


..8 polygons  : List of 1 


http: //www.hzcourse.com/resource/readBook?path-/openresources/teact. 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teact. 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teact 
http: //www.hzcourse.com/resource/readBook?pat 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teact. 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teact. 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teact 
http: //www.hzcourse.com/resource/readBook?pat 
http: //www.hzcourse.com/resource/readBook?pat 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teact 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teact 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teact. 


openresources/teacl 


openresources/teacl 
openresources/teack 


..8 plotOrder : int 1 


..8 bbox 


http: //www.hzcourse.com/resource/readBook?pat 
http: //www.hzcourse.com/resource/readBook?pat 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teact. 


num [1: 2, 1: 2] 121.2 43.4 135.1 53.6 
openresources/teactk 
openresources/teack 


..8 proj4string: Formal class 'CRS' [package "sp"] with 1 slots 


http: //www.hzcourse.com/resource/readBook?path-/openresources/teact. 


从 这 两 个 维度 观察 ， 我 们 基本 清楚 map 的 结构 ，map 里 每 一 行 是 一 个 SpatialPolygonsDataFrame 对 象 ， 包 括 5 个 属性 ， 用 于 存储 地 图 数据 信息 。 取 第 一 行 数据 data 属 性 ， 查 看 结果 ， 发 现 是 黑龙 江 省 
的 行政 区 地 图 数据 。 
> map[1, ]8data 


0 


AREA PERIMETER 
54.447 68.489 


BOU2 4M  BOU2 4M ID  ADCODE93 ^ ADCODE99 NAME 
2 23 230000 230000 黑龙 江 省 


第 一 行 数据 画图 就 得 


到 黑龙 江 省 的 行政 区 地 


IR] 


> 


plot (map[1, ]) 


如 果 取 前 100 行 数据 画图 ， 那 么 应 该 是 部 分 省 份 的 行政 区 地 图 。 


> plot (map[1: 100, ]) 


由 于 本 节 并 不 是 地 图 包 


4. 


数据 可 视 化 


完成 了 地 图 数据 的 加 载 


的 详细 介绍 ， 只 要 了 解 到 map 对 象 的 基本 使 用 就 行 了 。 


后 ， 再 接 下 来 就 是 数据 可 视 化 了 。 数 


我 们 先 思考 一 下 要 怎么 进行 数据 处 理 才 能 把 天 气 数据 和 地 图 数据 结合 起 来 呢 。 我 们 的 目标 是 要 画 出 中 国 各 省 天 气概 况 ， 会 
code 代 码 和 实际 意义 的 映射 关系 。Yahoo 的 源 数 据 中 ， 一 共 定义 了 49 种 天 气 情 况 ， 如 code.csv 文 件 所 示 ， 根 据 描述 我 把 相似 的 天 气 情况 进行 合并 ， 最 后 保留 18 种 天 气概 况 特征 。code 代 码 映 射 文件 为 
lablecode.csv。code.csv 文 件 如 下 : 


"c 


Q0 -1oU05U0NP^O 


ode", 
tornado, A EA, 3 


en", "zh", "type" 


tropical storm, iid AE, 2 


hurricane, XJ, 3 


severe thunderstorms, EHK, 16 
thunderstorms, $, 11 

mixed rain and snow, h$, 12 

mixed rain and sleet, i$, 12 
mixed snow and sleet, i$, 12 


freezing drizzle, 
drizzle, ££, 11 


ELER, 11 


10, freezing rain, %®, 11 


, Showers, m, 11 
, Showers, m, 11 


, snow flurries, 4, 13 
, light snow showers, $, 13 
, blowing snow, t€, 13 


居 可 视 化 ， 我 认为 要 分 成 2 部 分 操作 ， 一 部 分 是 数据 处 理 ， 另 一 部 分 是 可 视 化 输出 。 


到 之 前 过 滤 出 的 数据 中 code 的 数据 ，code 的 数据 都 是 代码 ， 我 们 还 要 定义 


16, snow, $, 14 

17, hail, €, 15 

18, sleet, M$, 12 

19, dust, Kt, 5 

20, foggy, F, 7 

21, haze, i$*€, 7 

22, smoky, JH Ai, 6 

23, blustery, KA, 3 

24, windy, M, 4 

25, cold, », 18 

26, cloudy, $z, 8 

27, mostly cloudy (night) , i 
28, mostly cloudy (day) , iz 
29, partly cloudy (night) ， 少 
30, partly cloudy (day) , 少 
31, clear (night) , mW, 10 
32, sunny, "b, 10 

33, fair (night) , Wf, 10 
34, fair (day) , f, 10 

35, mixed rain and hail, XiS4wX&, 16 
36, hot, 4A, 1 
37, isolated thunderstorms, 局 部 雷雨 ， 
38, scattered thunderstorms, 
39, scattered thunderstorms, € $$, 11 
40, scattered showers, £59, 11 

41, heavy snow, KẸ, 14 

42, scattered snow showers, € I$, 13 
43, heavy snow, K'Ẹ, 14 

44, partly cloudy, VA, 9 

45, thundershowers, d M-m, 11 

46, snow showers, $$, 13 

47, isolated thundershowers， 局 部 雷雨 ，11 
3200, not available, 无 数据 ，19 


字段 解释 如 下 : 

“ code， 源 数据 天 气 特征 代码 
'“ en， 英文 描述 

“ zh， 中 文 描述 

“ type， 分 类 代码 


lablecode.csv 文 件 如 下 : 


"type", "alias" 
E 


Ii 0 -10| OS QI HE 


Kid ab oar 8 uio NIU 
与 


字段 解释 如 下 : 
“ type， 分 类 代码 


“ alias， 用 于 显示 的 别名 


网 


有 了 天 气 特征 定义 后 ， 我 们 再 把 特征 匹配 到 不 同 的 颜色 ， 并 增加 图 例 及 文字 描述 ， 就 生成 了 最 终 的 中 国 各 省 天 气概 况 的 静态 


网 


片 了 。 


> library ("RColorBrewer") 
» getColors2«-function (map, prov, ctype) ( 


* #name change to ADCODE99 
* ADCODE99«-read.csv (file-"ADCODE99.csv", header-TRUE, fileEncoding-"utf-8", encoding="utf-8") 
十 fc«-function (x) (ADCODE99$ADCODE99 [which (x==ADCODE99$prov) ]} 
* code«-sapply (prov, fc) 
* f-function (x, y) ifelse (x $in$ y, which (y--x) , 0) ; 
* colIndex-sapply (map$ADCODE99, f, code) ; 
* ctype [which (is.na (ctype) ) ]-19 
* return (ctype[colIndex]) 
+} 
> summary<-function (data=data, output=FALSE, path='') { 
+ colors<-c (rev (brewer.pal (9, "Blues") ) , rev (c ('#b80137', '#8c0287', '#d93c5d', '#d98698', 
'$£60400', '£c4c4a7', '#d6d6cb', '4d10747', '#ffeda0') ) ) # 定义 18 种 天 气 特 征 对 应 的 颜色 
本 
+ temp<-data$code 
+ title<-" 中 国 各 省 天 气概 况 " 
十 ofile«-paste (format (date, d") , " code.png", sep- 
* sign«-'' 
* colors«-rev (colors) 
* code«-read.csv (file-"code.csv", header-TRUE, fileEncoding-"utf-8", encoding-"utf-8") 
* labelcode«-read.csv (file-"labelcode.csv", header-TRUE, fileEncoding-"utf-8", encoding-"utf-8") 
* ctype«-sapply (temp, function (x) (code$type[which (x--code$code) ]]) 
十 
* if (output) png (file-paste (path, ofile, sep-'') , width=600, height-600) 
* layout (matrix (data-c (1, 2) , nrow-1, ncol-2) , widths-c (8, 1) , heights=c (1, 2) ) 
* par (marec (0, 0, 3, 12) , oma-c (0.2, 0.2, 0.2, 0.2) , mex-0.3) 
* plot (map, border-"white", col-colors[getColors2 (map, data$prov, ctype) ]) 
# 地 图 和 天 气 可 视 化 
* points (data$long, data$lat, pch-19, colergb (0, 0, 0, 0.3) , cex-0.8) # 标 出 采样 城市 
十 
* SSE # 图 片 中 的 辅助 文字 
* if (FALSE) { 
十 grid () 
* axis (1, lwd-0) ; axis (2, lwd-0) ; axis (3, lwd-0) ; axis (4, lwd-0) 
+ } 
+ text (100, 58, title, cex=2) 
+ text (105, 54, format (date, "$Y-$m-$d") ) 
十 text (98, 65, paste ('JFH TE X &', 'http: //apps.weibo.com/chinaweatherapp') ) 
* text (120, -8, paste ('provided by The Weather Channel', format (date, "$Y-$m-$d $H: M") ) , cex-0.8) 
十 
* #========== ———— # 文字 说 明 
* for (row in 1: nrow (data) ) { 
十 name«-as.character (data$zh[row]) 
* label«-labelcode$alias [labelcode$type--ctype [row] ] 
十 xl«-ceiling (row/7) 
* x2«-ifelse (row$$7--0, 7, row$$7) 
* x3«-ctype[row] 


* fontCol«-'$000000' 

十 if (x3«-5) fontCol«-head (colors, 1) 

* if (x3»-12) fontCol«-tail (colors, 1) 

* text (684x1*11, 17-x2*3, paste (name, ' ', label, sign, sep-'') , col-fontCol) 

* } 

+ 

+ 间 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 一 = 一 一 一 一 一 一 一 一 一 一 一 * 图 例 

* par (mr = c (5, 0, 15, 10)) 

十 image (x-1, y=1: length (colors) , z-t (matrix (1: length (colors) ) ) , col=rev (colors) , axes-FALSE, 
xlab-"", ylab-"", xaxt-"n") 

十 axis (4, at = 1: (nrow (labelcode) -1) , labels=rev (labelcode$alias) [-1], col = "white", 
las = 1) 

十 abline (h=c (1: (nrow (labelcode) -2) 40.5) , col = "white", lwd = 2, xpd = FALSE) 

十 if (output) dev.off () 

+} 


运行 程序 ， 生 成 中 国 各 省 天 气概 况 的 静态 图 片 。 


[ 


> data«-read.csv (file-filename (date) , header-TRUE, fileEncoding-"utf-8", encoding="utf-8") 


> path-'' + 定义 输出 路 径 
> summary (data, output=TRUE, path=path) # 生成 中 国 各 省 天 气概 况 图 
RStudioGD 

2 


大 概 100 行 左右 代码 就 可 以 生成 这 么 复杂 的 天 气 和 地 图 结合 的 图 片 ，R 真 的 很 神奇 ! 


网 


5. 可 交互 的 静态 图 


这 是 锦上添花 的 一 步 ， 静 态 图 片 对 于 一 般 应 用 来 说 就 够 了 。 但 如 果 
HTML5 的 动画 ， 生 成 会 动 的 可 交互 的 图 片 。 


网 


由 于 recharts 包 没有 发 布 的 CRAN ， 我 们 需 


devtools 包 通过 Github 安 装 这 个 包 。 


片 还 能 动 起 来 ， 是 不 是 会 更 吸引 人 呢 ? 我 们 可 以 尝试 生成 基于 HTML5 的 、 有 动态 效果 的 图 


， 通 过 recharts 包 调 Echarts 库 实现 基于 


> library (devtools) # 加 载 devtools 
> install github ("taiyun/recharts") # 下 载 安装 recharts 包 
> library (recharts) # 加 载 recharts 包 


由 于 上 面 的 天 气概 况 是 由 离散 值 组 成 的 ， 我 们 需要 利用 echarts 的 库 做 一 个 连续 值 的 可 视 化 例子 ， 比 如 白天 气温 和 夜间 气温 。 定 义 weather_html () 函数 ， 提 供 气 温 数据 并 调 


化 的 输出 。 
> weather html«-function (data-data, type-'high', output-FALSE, path-'') { 
# 输入 HTML 的 天 气 图 
十 if (type--'high') ( # 白天 气温 
* df«-data[, c ('prov', 'high') ] 
十 names (df) «-c ("Prov"，" 气温") 
十 title«-paste (format (date, "$Y-$m-$d") , "中 国 各 省 白天 气温 "，sep="") 
十 ofile«-paste (format (date，"g%Y%mgsd") , " day.html", sep-"") 
十 }else if (type--'low') ( # 夜间 气温 
十 df«-data[, c ('prov', 'low') ] 
* names (df) «-c ("prov", "^Lià") 
ES title«-paste (format (date, "$Y-$m-$d") ，" 中 国 各 省 夜间 气温 "，sep="") 
* ofile«-paste (format (date, "$Y$m$d") , " night.html", sep-"") 
* } 
+ 
+ df[, 1]<-substr (df[, 1], 0, 2) # 数据 格式 整理 
十 df[which (df$prov==' 黑 龙 ') , ]$prov«-' £ Xr" 
十 df [which (df$prov==' 内 蒙 ') ，] $prov<-' 内 蒙古 ' 
+ 
* recharts.eMap <- eMap (df, namevar-1l, datavar = 2, title-title) 


# 数据 JSON 化 处 理 
if (output) { # 输出 HTML 文 件 
recharts.eMapSoutList[c ('chartid', 'type') ]«-NULL 
writeLines (unlist (recharts.eMap$outList) , paste (path, ofile, sep-'') ) 
Jelset + 在 浏览 器 中 打开 HTML 网 页 
plot (recharts.eMap) 
} 


十 十 十 十 十 十 十 


recharts 包 ， 实 现 可 视 


运行 以 下 程序 ， 以 HTML 输 出 中 国 各 省 白天 气温 。 


> date<-as.Date ('20141001', format-'$Y$m&d') + 设置 日 期 

> data<-read.csv (file=filename (date) , header=TRUE, fileEncoding="utf-8", encoding="utf-8") 
+ 加 载 数据 

> path-'' # 设置 文件 输出 路 径 

> weather html (data, type-'high', output-FALSE, path-'') # 输出 中 国 各 省 白天 气温 

[1] "气温 " 


[1] "chart path C: NNUsers WADMINI-1NMAppData WW LocalN Temp NNRtmpqCHFPY" 


程序 会 自动 打开 浏览 器 ， 呈 现 HTML 的 网 页 。 


运行 下 面 的 程序 ， 以 HTML 输 出 中 国 各 省 夜间 气温 。 在 网 页 中 ， 通 过 鼠标 对 地 图 进行 交互 ， 移 动 左 下 角 的 温度 条 ， 选 择 最 高 温度 30， 最 低温 度 8.8， 中 


温度 不 在 8.8 到 30 度 之 间 。 当 鼠标 滑 过 海南 省 的 时 候 ， 海 南 省 呈现 黄色 ， 并 提示 温度 为 23 度 。 


> weather html (data, type-'low', output-FALSE, path-'') * 中 国 各 省 夜间 气温 
[1] "气温 " 
[1] "chart path C: \\Users\\ADMINI~1\\AppData\\Local\\Temp\\RtmpgqCHFPY" 


国 地 图 


中 由 西 


到 东北 变 为 灰色 ， 说 明 这 些 地 


如 果 不 需要 在 浏览 器 中 打开 ， 只 想 存 储 生成 的 网 页 ， 可 以 在 程序 中 设置 output 为 TRUE， 当 前 目录 下 会 生成 20141001_night.html 的 文件 。 


> weather html (data, type-'low', output-TRUE, path-'') 
n] "Ai" 


1] "气温 


本 节 介绍 了 每 日 中 国 天 气 应 用 项 目 完整 情况 ， 并 完成 R 语 言 部 分 的 功能 实现 。 那 么 下 一 节 ， 将 介绍 如 何 把 R 语 言 的 功能 代码 封装 成 R 包 。 


[1] 本 节 后 面 以 及 5.4 节 的 效果 图 请 读者 自己 运行 R 代 码 查看 。 


54 _R 包 开发 一 一 每 日 中 国 天 气 


问题 


如 何 把 R 语 言 应 用 程序 封装 成 R 包 ? 


/ 


本 节 将 继续 5.3 节 的 内 容 ， 把 我 们 已 经 完成 的 R 语 言 程 序 ， 封 装 成 R 语 言 程序 包 。 


check () 函数 的 顺利 执行 ， 代 码 有 多 处 改动 。 


在 5.3 节 中 ， 我 们 写 的 R 程 序 都 在 Windows 中 完成 ， 由 于 R 的 跨 平台 代码 有 兼容 性 的 问题 ， 我 们 的 应 


发 。 
本 节 的 系统 环境 是 : 
: Linux: Ubuntu Server 12.04.2 LTS 64bit 
< R: 3.1.1 x86. 64-pc-linux-gnu. (64-bit) 


- RStudio-Server 0.97.551 


"y" 
R 包 开发 - 每 日 中 国 天 气 


http://blog.fens.me/r-package-chinaweather/ 


在 5.2 节 中 ， 我 们 其 实 已 经 创建 好 了 chinaWeather 项 目 ， 那 么 R 包 的 开发 将 继续 在 这 个 项 目 中 进行 。 进 入 chinaWeather 项 


BIA. 


— cd /home/conan/R/chinaWeather 
* app 
master 


查看 Linux 系 统 中 R 语 言 环境 变量 的 设置 ， 字 符 集 是 特别 要 处 理 的 部 分 。 


> sessionInfo () 
R version 3.1.1 (2014-07-10) 
Platform: x86 64-pc-linux-gnu (64-bit) 
locale: T 
[1] LC CTYPE-en US.UTF-8 
] LC TIME-zh CN.UTF-8 
[5] LC MONETARY-zh CN.UTF-8 
] LC PAPER-zh CN.UTF-8 LC NAME-C 
] LC ADDRESS-C LC TELEPHONE-C 
[11] LC MEASUREMENT-zh CN.UTF-8 LC IDENTIFICATION-C 
attached base packages: D 
[1] stats graphics grDevices utils 


LC NUMERIC-C 
LC COLLATE-en US.UTF-8 
LC MESSAGES-en US.UTF-8 


datasets methods 


环境 准备 就 绪 ， 下 面 就 可 以 开始 R 包 开发 的 工作 了 。 


在 开始 写 R 包 代码 之 前 ， 我 们 需要 先 整理 静态 数据 。 这 个 项 目 中 ， 静 态 数据 包括 了 地 


# 进入 项 目 目录 ~ git branch app 


程序 最 终 将 在 Linux 中 发 布 ， 所 以 为 了 减少 发 布 时 不 必要 的 麻烦 ， 我 们 转 到 Linux 系 统 中 完成 R 包 的 


F 


A——M A 


这 个 看 起 来 简单 的 任务 ， 其 实 要 花 很 多 的 时 间 来 处 理 细 节 。 整 个 的 R 包 开发 过 程 ， 将 按照 5.2 节 的 流程 进行 ， 为 了 保证 


的 目录 ， 为 了 保证 5.2 节 代码 的 独立 性 ， 我 单独 开 一 个 Git 分 支 ， 进 行 本 节 的 R 


# 新 建 分 支 ， 名 为 app~ git checkout app # 切换 


数据 、WOEID 映 射 数 据 、 天 气概 况 的 映射 数据 、 中 英文 图 片 可 视 化 数据 、 测 试 数据 集 。 对 于 普通 的 R 应 用 程序 来 


说 可 以 用 CSV 格 式 保存 文件 在 本 地 ， 但 对 于 R 包 项 目 来 说， 最 好 是 封装 成 rda 的 数据 文件 ， 随 R 包 一 起 打包 发 布 。 


首先 ， 我 们 就 要 对 这 些 静态 数据 文件 进行 整理 ， 新 建 目 录 metadata， 用 于 存储 原始 CSV 文 件 和 地 图 文件 。 


~ mkdir /home/conan/R/chinaWeather/metadata 4 新 建 目 录 ， 并 把 原 数据 文件 复制 到 metadata 目 录 ~ ls -1 /home/conan/R/chinaWeather/metadat. 
-rw-rw-r-- 1 conan conan 3396 10 月 4 22: 14 20141001.csv # 测试 数据 集 
-rw-r--r-- 1 conan conan 754 2 月 5 2013 ADCODE99.csv # RDCODE99 与 省 份 中 文 映射 数据 
-rw-r--r-- 1 conan conan 1418 2 月 6 2013 code.csv # Yahoo 天 气概 况 映射 数据 
-rw-r--r-- 1 conan conan 214 2 月 6 2013 labelcode.csv # 简化 后 天 气概 况 映射 数据 
drwxr-xr-x 2 conan conan 4096 4 月 23 2013 mapdata # 地 图 数据 目录 
-rw-rw-r-- 1 conan conan 1900 2 月 4 2013 WOEID.csv 4 WOEID 上 映射 数据 ~ ls -l /home/conan/R/chinaWeather/metadata/mapdata 
-rw-r--r-- 1 conan conan 86283 4H 10 1999 bou2 4p.dbf 
1 conan conan 1508752 4H 10 1999 bou2 4p.shp 
1 conan conan 7500 4H 10 1999 bou2 4p.shx 


a # metadata $ 


# 查看 地 图 数据 文件 


把 静态 数据 转换 为 rda 格 式 的 文件 ， 存 储 在 data 目 录 中 。 


~ mkdir /home/conan/R/chinaWeather/data # 新 建 目录 data~ R + 启动 R 语 言 程序 。 


1.WOEID 数 据 文 件 WOEID.rda 


对 WOEID 数 据 进行 处 理 ， 要 把 adcode99 代 码 合 并 到 WOEID 数 据 集中 。 下 面 合并 WOEID.csv 文 件 和 ADCODE99.csv 文 件 的 数据 ， 生 成 WOEID.rda 的 文件 。 


> WOEID«-read.csv (file-"metadata/WOEID.csv", header-FALSE, fileEncoding-"utf-8", 
encoding-"utf-8") # 加 载 NOEID 数 据 集 
> names (WOEID) «-c ("en", "woeid", "zh", 'prov', 'long', 'lat') 
adcode99«-read.csv (file-"metadata/ADCODE99.csv", header-TRUE, fileEncoding-"utf-8", 
encoding-"utf-8") 3 加 载 ADCODE99 数 据 集 


v 


> fc<-function (row) { 
+ code<-adcode99$ADCODE99 [which (row[4]==as.character (adcode99$prov) ) ] 
+ if (length (code) ==0) code=0 
+ code 
+} 
> WOEID«-cbind (WOEID, adcode99-unlist (apply (WOEID, 1, fc) ) ) # 合并 数据 集 
> save (WOEID, file="data/WOEID.rda") 4 生成 WOEID.rda 文 件 
> WOEID * 合并 后 的 WOEID 数 据 集 
en woeid zh prov long lat adcode99 
1 beijing 2151330 北京 北京 市 116.46667 39.90000 110000 
2 shanghai 2151849 上 海 上 海 市 121.48333 31.23333 310000 
3 tianji 2159908 天 津 天 津 市 117.18333 39.15000 120000 
4 chongqing 20070171 重庆 重庆 市 106.53333 29.53333 500000 
5 harbin 2141166 哈尔滨 黑龙 江 省 126.68333 45.75000 230000 
6 changchun 2137321 长 春 吉林 省 125.31667 43.86667 220000 
3 shenyang 2148332 沈阳 辽宁 省 123.40000 41.83333 210000 
8 hohhot 2149760 呼和浩特 内 蒙古 自治 区 111.80000 40.81667 150000 
9 shijiazhuang 2171287 石家庄 河北 省 114.46667 38.03333 130000 
10 wulumugi 26198317 LITT 新 疆 维 吾 尔 自治 区 87.60000 43.80000 650000 
11 lanzhou 2145605 兰州 甘肃 省 103.81667 36.05000 620000 
12 xining 2138941 西宁 青海 省 101.75000 36.63333 630000 
13 xian 2157249 西安 陕西 省 108.90000 34.26667 610000 
14 yinchuan 2150551 银川 宁夏 回族 自治 区 106.26667 38.33333 640000 
15 zhengzhou 2172736 郑州 河南 省 113.70000 34.80000 410000 
16 jinan 2168327 济南 山东 省 117.00000 36.63333 370000 
17 taiyuan 2154547 太原 山西 省 112.56667 37.86667 140000 
18 hefei 2127866 合肥 安徽 省 117.30000 31.85000 340000 
19 wuhan 2163866 武汉 湖北 省 114.35000 30.61667 420000 
20 changsha 26198213 长 沙 湖南 省 113.00000 28.18333 430000 
21 nanjing 2137081 南京 江苏 省 118.83333 32.03333 320000 
22 chengdu 2158433 成 都 四 川 省 104.08333 30.65000 510000 
23 guiyang 2146703 贵阳 贵州 省 106.70000 26.58333 520000 
24 kunming 2160693 昆明 云南 省 102.68333 25.00000 530000 
25 nanning 2166473 南宁 广西 壮族 自治 区 108.33333 22.80000 450000 
26 lasa 26198235 拉萨 西藏 自治 区 91.16667 29.66667 540000 
27 hangzhou 2132574 杭州 浙江 省 120.15000 30.23333 330000 
28 nanchang 26198151 南昌 江西 省 115.86667 28.68333 360000 
29 guangzhou 2161838 广州 广东 省 113.25000 23.13333 440000 
30 fuzhou 2139963 福州 福建 省 119.30000 26.08333 350000 
31 taipei 2306179 台北 台湾 省 121.51667 25.05000 710000 
32 haikou 2162779 海口 海南 省 110.33333 20.03333 460000 
33 hongkong 24865698 香港 香港 特别 行政 区 114.16667 22.30000 810000 
34 macau 20070017 澳门 澳门 特别 行政 区 113.50000 22.20000 0 


我 们 看 到 WOEID 数 据 集 包 括 了 中 文字 符 ， 而 R 语 言 的 rda 规 范 中 ， 要 求 不 能 包括 ASCII 以 外 的 字符 集 。 在 执行 check () 检查 的 过 程 中 ， 就 会 遇 到 非法 字符 集 的 错误 警告 。 


行 特 殊 转 码 处 理 ， 把 中 文字 符 统一 转 码 成 unicode 来 表示 ， 如 北京 unicode 转 码 后 表示 为 \u5317\u4eac。 当 数据 集 用 中 文 显示 的 时 候 ， 需 要 再 反 转 U 


对 WOEID 的 数据 集 转 码 处 理 ， 我 们 需要 用 到 stringi 包 。 


因此 ， 就 需要 对 中 文 数据 集 进 


nicode 到 中 文 ， 这 样 中 文 就 可 以 与 R 语 言 程序 兼容 


T. 


» install.packages ("stringi") # 安装 stringi 包 
> library ("stringi") # 加 载 stringi 包 


通过 stri escape_unicode () 函数 ， 对 WOEID 数 据 集 的 zh 和 prov 列 的 中 文 进行 unicode 转 码 。 


> WOEID$prov«-stri escape unicode (WOEID$prov) # 对 WOEID$prov 列 转 码 
> WOEIDSzh«-stri escape unicode (WOEID$zh) # 对 WOEIDSzh 列 转 码 
> save (WOEID, file-"data/WOEID.rda", compress-TRUE) d 保存 数据 集 
> head (WOEID) H 查看 转 码 后 的 WOEID 数 据 集 
en woeid zh Prov long 

lat adcode99 adcode99 
1 beijing 2151330 \\u5317\\u4eac\\u5317\\u4eac\\u5e02 116.4667 39.90000 110000 110000 
shanghai 2151849 \\u4e0a\\u6d77 NNu4e0aNNu6d77NNu5e02 121.4833 31.23333 310000 310000 
tianji 2159908 \\u5929\\u6d25\\u5929\\u6d25\\u5e02 117.1833 39.15000 120000 120000 
chongqing 20070171NNu91cdNNu5e86 NNu91edNNu5e86NNu5e02 106.5333 29.53333 500000 500000 
harbin 2141166 \\u54c8\\u5cl4\\u6ee8 NNu9ediNNu9£99NNu6c5£NNu7701 126.6833 45.75000 

230000 230000 
6 changchun 2137321 NNu957fNNu6625 NNu5409NN06797NNu7701 125.3167 43.86667 220000 220000 


[LENS] 


我 们 再 试 一 下 ， 把 unicode 的 数据 转 码 成 原来 的 中 文字 符 ， 通 过 stri_unescape_unicode () 函数 实现 。 


> head (stri unescape unicode (WOEID$prov) ) 


[1] "北京 市 "” "上 海 市 "天 津 市 " "重庆 市 "ERLA" "吉林 省 " 
> head i unescape unicode (WOEID$zh) ) 
[1] "dx" CC" TRR" "ek" "AiR" "RA" 


转 码 的 操作 正常 ， 所 以 在 遇 到 非 AsClI 的 字符 集 ， 我 们 就 可 以 用 这 种 方式 进行 转换 了 。 


2. 地 图 数据 文件 chinaMap.rda 


对 地 图 数据 进行 处 理 ， 加 载 原始 地 图 数据 ， 生 成 chinaMap.rda 文 件 。 在 chinaMap 对 象 中 ，NAME 列 是 中 文字 符 ， 在 Linux 系 统 中 直接 加 载 地 | 


四 | 


[ 


数据 时 ， 由 于 系统 默认 使 用 UTF-8 的 字符 编码 ， 所 


GKB 类 型 的 字符 显示 为 乱码 ， 我 们 可 以 用 iconv () 函数 进行 转 码 ， 然 后 再 通过 上 面 介 绍 的 unicode 转 码 方法 保存 。 但 由 于 NAME 列 数据 ， 我 们 刚好 


不 到 ， 一 种 简单 的 操作 方法 就 是 将 NAME 列 从 数 


以 读 
居 集 中 


» library (maps) 

» library (mapdata) 

» library (maptools) 

> chinaMapc-readShapePoly ('metadata/mapdata/bou2 4p.shp') # 加 载 地 图 数据 

> head (chinaMap$NAME) # NAME 列 ， 非 ASCII 编 码 

[1] \xba\xda\xcl\xfa\xbd\xad 

[2] \xc4\xda\xc3\xc5\xd7\xd4\xd6\xce\xc7\xf8 

[3] \xd0\xae\xce\xel\xb6\xfb\xd7\xd4\xd6\xce\xc7\xf8 

[4] \xbc\xaa\xcl\xd6 

[5] \xcl\xc9\xc4\xfe 

[6] \xb8\xca\xcb\xe0 

33 Levels: \xb0\xb2\xbb\xd5 http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... \xd6\xd8\xc7\xec\xca\xd0 
> iconv (head (chinaMap$NAME) , "gbk", "UTF-8") # 把 NAME 列 ， 转 码 为 UTF-8 T 


[1] "黑龙 江 省 " "内 蒙古 自治 区 " "新 疆 维吾尔 自治 区 " "ERA" "ITA" "甘肃 省 " 
> chinaMap«-chinaMap[, c (1: 6) ] # OXGENAMES] 
» save (chinaMap, file-"data/chinaMap.rda", compress-'xz') 4 生成 chinaMap .rda 文 件 


3. 中 英文 图 片 可 视 化 数据 props.rda 


对 于 可 视 化 的 图 片 输出 时 ， 用 中 文 名 的 字段 显示 ， 生 成 props.rda 文 件 ， 中 文 编码 通过 转 成 unicode 进 行 处 理 。 


props«-data.frame ( 

key-c ('high', 'low') , 

zhec ( "中 国 各 省 白天 气温 '，'" 中 国 各 省 夜间 气温 ') ， 

en-c ('Daytime Temperature', 'Nighttime Temperature') 


props$zh«-stri escape unicode (props$zh) 
save (props, file-"data/props.rda", compress-TRUE) 


VVvV++++V 


4. 测 试 数据 集 weather20141001.rda 


以 2014 年 10 月 01 日 的 天 气 数据 集 作 为 一 个 demo 数 据 集 ， 生 成 weather20141001.rda 文 件 ， 中 文 编码 通过 转 成 unicode 进 行 处 理 。 


> weather20141001«-read.csv (file-"metadata/20141001.csv", header-TRUE, fileEncoding- 
"utf-8", éencoding-"utf-8") # 加 载 数据 文件 
> weather20141001$prov«-stri escape unicode (weather20141001$prov) 
4 对 weather20141001$prov 列 转 码 
> weather20141001$zh«-stri escape unicode (weather20141001$zh) 
# 对 weather20141001$zh 列 转 码 
> save (weather20141001, file-"data/weather20141001.rda", compress-TRUE) 
# 生成 weather20141001.rda 文 件 。 


查看 data 目 录 下 面 的 文件 列表 ， 生 成 了 4 个 静态 数据 集 文件 。 


> dir ('data') 
[1] "WOEID.rda" "chinaMap.rda" "props.rda"  "weather20141001.rda" 


所 有 的 静态 数据 集 都 已 预先 整理 好 ， 下 面 的 R 包 代码 ， 就 可 以 直接 使 用 这 些 静 态 数据 集 了 。 


5.4.3 ”编写 功能 代码 
按照 函数 功能 的 不 同 ， 我 们 定义 4 个 文件 来 描述 这 些 函 数 。 
< getDataR， 用 于 定义 候 取 数据 的 函数 。 


“ render.R， 用 于 静态 图 片 可 视 化 泻 染 的 函数 。 


* chinaWeather.R， 用 于 定义 各 种 工具 函数 。 
* chinaWeather-packages.R， 用 于 定义 R 包 内 的 数据 集 。 


1. 文 件 getData.R 


新 建文 件 getData.R， 用 于 疏 取 数据 和 XML 文档 解析 ， 文 件 中 定义 了 3 个 函数 。 


- getWeatherFromYahoo () ， 从 Yahoo 的 开放 数据 源 ， 获 取 天 气 数据 。 
. getWeatherByCity () ， 通 过 城市 英文 名 ， 获取 当前 城市 的 天 气 数据 。 


< getWeather () ， 获 取 中 国 省 会 城市 的 天 气 数据 ， 在 WOEID 数 据 集中 定义 的 城市 。 


~ vi R/getData.R 

#' Get weather data from Yahoo openAPI. 

p 

#' GimportFrom RCurl getURL 

#' GimportFrom XML xmlTreeParse getNodeSet xmlGetAttr 

#' Gparam woeid input a yahoo woeid 

#' Greturn data.frame weather data 

#' Gkeywords weather 

#' Gexport 

#' Gexamples 

#' Ndontrun( 

#' getWeatherFromYahoo () 

#' getWeatherFromYahoo (2151330) 

H} 

getWeatherFromYahoo<-function (woeid=2151330) { 
url«-paste ('http: //weather.yahooapis.com/forecastrssw-', woeid, '&u-c', sep="") 
doc = xmlTreeParse (getURL (url) , useInternalNodes-TRUE) 
ans«-getNodeSet (doc, "//yweather: atmosphere") 
humidity«-as.numeric (sapply (ans, xmlGetAttr,  "humidity") ) 
visibility«-as.numeric (sapply (ans, xmlGetAttr, "visibility") ) 
pressure«-as.numeric (sapply (ans, xmlGetAttr, "pressure") ) 
rising«-as.numeric (sapply (ans, »xmlGetAttr, "rising") ) 
ans«-getNodeSet (doc, "//item/yweather: condition") 
code«-as.numeric (sapply (ans, xmlGetAttr, "code") ) 
ans«-getNodeSet (doc, "//item/yweather: forecast[1]") 
low«-as.numeric (sapply (ans, xmlGetAttr, "low") ) 
high«-as.numeric (sapply (ans, xmlGetAttr,  "high") ) 
print (paste (woeid, '==>', low, high, code, humidity, visibility, pressure, rising) ) 
return (as.data.frame (cbind (low, high, code, humidity, visibility, pressure, rising) ) ) 

} 

#' Get one city weather Data. 

" 

$' Gparam en input a English city name 


#' Gparam src input data source 
#' Greturn data.frame weather data 
#' Gkeywords weather 
#' Gexport 
#' Gexamples 
#' Ndontrun( 
#' getWeatherByCity () 
#' getWeatherByCity (en-"beijing") 
LANI 
getWeatherByCity«-function (en-"beijing", src-"yahoo") ( 
woeid«-getWOEIDByCity (en) 
if (src--"yahoo") { 
return (getWeatherFromYahoo (woeid) ) 
Jelset 
return (NULL) 


#' Get all of city weather Data. 


#' Gparam lang input a language 

#' Gparam src input data source 

#' Greturn data.frame weather data 

#' Gkeywords weather 

#' Gexport 

#' Gexamples 

#' \dontrun{ 

#' getWeather () 

$t 

getWeather«-function (lang-"en", src-"yahoo") ( 
cities«-getCityInfo (lang) 
wdata«-do.call (rbind, lapply (cities$woeid, getWeatherFromYahoo) ) 
return (cbind (cities, wdata) ) 

} 


2. 文 件 render.R 


新 建文 件 render.R， 用 于 数据 处 理 和 静态 图 片 可 视 化 泻 染 ， 文 件 中 定义 了 5 个 函数 。 


“ getColors () ， 根 据 天 气 情况 匹配 不 同 的 颜色 
- drawBackground () ， 通 出 背景 

- drawDescription () ， 画 出 文字 描述 
“drawLegend () ， 画 出 图 例 


- drawTemperature () ， 画 出 气温 及 地 图 结合 


~ vi R/render.R 

#' match the color with ADCODE99. 

" 

#' Gparam temp the temperature 

#' Gparam breaks cut the numbers 

#' Greturn new color vector 

#' Gkeywords color 

getColors«-function (temp, breaks) { 
f=function (x, y) ifelse (x $in$ y, which (y==x) , 0) 
colIndex-sapply (chinaMapS$ADCODE99, f, WOEID$adcode99) 
arr <- findInterval (temp, breaks) 
arr[which (is.na (arr) ) ]-19 
return (arr[colIndex]) 

} 

#' Draw the background. 
' 


#' Gparam title the image's title 
#' Gparam date the date 
#' Gparam lang the language zh or en 
drawBackground«-function (title, date, lang-'zh') ( 
text (100, 58, title, cex-2) 
text (105, 54, format (date, "$Y-$m-$d") ) 
#text (98, 65, paste ('chinaweatherapp', 'http: //apps.weibo.com/chinaweatherapp') ) 
#text (120, -8, paste ('provided by The Weather Channel', format (date, "%Y-%m-%d $H: 


") ) , cex-0.8) 
#' Draw the description. 


#' GimportFrom stringi stri unescape unicode 
#' Gparam data daily data 
#' Gparam temp the temperature 
#' Gparam lang the language zh or en 
drawDescription«-function (data, temp, lang-'zh') ( 
rows«-1: nrow (data) 
x«-ceiling (rows/7) *11468 
y<-17-ifelse (rows$$7--0, 7, rows$$7) *3 
fontCols«-c ("#08306B", "4000000", "4800026") [findInterval (temp, c (0, 30) ) +1] 
if (lang--'zh') ( 
txt«-stri unescape unicode (data$zh) 
text (x, y, paste (txt, temp) , col-fontCols) 
Jelset 
text (x, y, paste (data$en, temp) , col-fontCols) 
l 
#text (x, y, bquote (paste (. (data$en) , . (temp) , degree, C) ) , col-fontCols) 


#' Draw the legend. 


#' Gparam breaks cut the numbers 
#' Gparam colors match the color 
drawLegend«-function (breaks, colors) ( 
breaks2 «- breaks[-length (breaks) ] 
par (mr = c (5, 0, 15, 10)) 
image (x-1, y=0: length (breaks2) , z-t (matrix (breaks2) ) , colecolors[1: length (breaks) -1], 
axes-FALSE, breaks-breaks, xlab-"", ylab-"", xaxt-"n") 
axis (4, at = 0: (length (breaks2) ) , labels = breaks, col = "white", las = 1) 
abline (h = c (1: length (breaks2) ) , col = "white", lwd = 2, xpd = FALSE) 


#' Draw temperature picture. 


$' GimportFrom RColorBrewer brewer.pal 
#' GimportFrom stringi stri unescape unicode 
#' Gimport maptools 
#' Gparam data daily data 
#' Gparam lang language 
#' Gparam type low or high 
#' Gparam date the date 
#' Gparam output output a file or not 
#' Gparam path image output position 
#' Gexport 
drawTemperature«-function (data, lang-'zh', type-'high', date-Sys.time () , output-FALSE, path-'') ( 
colors «- c (rev (brewer.pal (9, "Blues") ) , "#ffffef", brewer.pal (9, "YlOrRd") , "#500000") 
breaks-seq (-36, 44, 4) 
if (type--'high') ( 
temp«-data$high 
ofile«-paste (format (date, "$Y$m$d") , " day.png", sep-"") 
Jelset 
temp«-data$low 


: 
if (lang--'zh') { 
title«-stri unescape unicode (Props [which (props$key--'high') , ]$zh) 


Jelset 
title«-props [which (props$key--'high') , ]$en 
$ 
if (output) png (filename-paste (path, ofile, sep='') , width=600, height=600) 
layout (matrix (data-c (1, 2) , nrow-l, ncol-2) , widths-c (8, 1) , heights-c (1, 2) ) 
par (mar-c (0, 0, 3, 10) , oma-c (0.2, 0.2, 0.2, 0.2) , mex-0.3) 
plot (chinaMap, border-"white", col-colors[getColors (temp, breaks) ]) 
points (data$long, data$lat, pch-19, colergb (0, 0, 0, 0.3) , cex-0.8) 
drawBackground (title, date, lang) 
drawDescription (data, temp, lang) 
drawLegend (breaks, colors) 


3. 文 件 chinaWeather.R 


修改 文件 chinaWeather.R， 用 于 定义 各 种 工具 函数 ， 文 件 中 定义 了 3 个 函数 。 
“ filename () ， 根 据 日 期 定义 文件 名 称 。 
: getWOEIDByCity () ， 通 过 城市 名 获得 WOEID 代 码 。 


“ getCityInfo () ， 查 看 所 有 城市 的 信息 ， 即 在 WOEID 数 据 集中 定义 的 城市 。 


#' Define a filename from current date. 
p 
#' @param date input a date type 
#' @return character a file name 
#' Gkeywords filename 
#' Gexport 
#' Gexamples 
#' Ndontrun( 
#' filename () 
#' filename (as.Date ("20110701", format-"$Y£m$d") ) 
f) 
filename«-function (date-Sys.time () ) { 
paste (format (date,  "$Y$m$d") , ".csv", sep-"") 


#' Get WOEID of Yahoo By City Name 


#' Gparam en input a English city name 

#' Greturn integer WOEID 

#' Gkeywords WOEID 

#' Gexport 

#' Gexamples 

\dontrun{ 

#' getWOEIDByCity () 

#' getWOEIDByCity (en-"beijing") 

E} 

getWOEIDByCity<-function (en="beijing") { 
return (WOEID$woeid[which (WOEID$en==en) ]) 


#' Get all of city info 


#' @param lang input a language 
#' Greturn data.frame city info 
#' Gkeywords language 
#' Gexport 
#' Gexamples 
#' Ndontrun( 
#' getCityInfo () 
#' getCityInfo (lang-"en") 
#' getCityInfo (lang-"zh") 
t} 
getCityInfo<-function (lang="en") { 
if (lang=="en") return (WOEID[-c (3, 4) ]) 
zh") return (WOEID[-c (4) ]) 


4.XfftchinaWeather-package.R 


新 建文 件 chinaWeather-package， 用 于 定义 R 包 的 说 明和 内 置 数据 集 。 


© NULL， 关 于 chinaWeather 包 的 定义 说 明 。 
"WOEID'，WOEID 数 据 集 的 描述 。 

“ 'chinaMap'，chinaMap 数 据 集 的 描述 。 

“ 'props'"，props 数 据 集 的 描述 。 


"weather20141001'，weather20141001 数 据 集 的 描述 。 


#' China Weather package. 
#' a visualized package for china Weather 


#' @name chinaWeather-package 

#' Galiases chinaWeather 

#' GdocType package 

#' Gtitle China Weather package. 

#' Gkeywords package 

NULL 

#' The yahoo code for weather openAPI. 


#' Gname WOEID 

$' Gdescription The yahoo code for weather openAPI. 

#' GdocType data 

#' Gformat A data frame 

$' (source Vurl(https: //developer.yahoo.com/geo/geoplanet/guide/concepts.html] 
"WOEID' 


#' (name chinaMap 

#' Gdescription China Map Dataset. 
#' GdocType data 

#' Gformat A S4 Object. 

'chinaMap' 

#' Charset for Chinease and English. 
P 

#' Gname props 

#' Gdescription Charset. 

#' GdocType data 

#' Gformat A data frame 


#' Dataset for 20141001. 


#' (name weather20141001 

#' (description A demo dataset. 
#' GdocType data 

#' Gformat A data frame 


$' (source Vurl(http: //weather.yahooapis.com/forecastrssw-2151330] 
'"weather20141001' 


544 ”项 目 配置 文件 


我 们 在 chinaWeather 项 目 中 ， 增 加 了 好 几 个 函数 定义 ， 同 时 增加 了 5 个 包 的 依赖 ， 那 么 项 目 配置 文件 也 需要 做 相应 的 修改 。 需 要 修改 的 文件 有 3 个 : 
- DESCRIPTION, 项 目 描述 文件 ， 用 于 项 目 全 局 的 配置 。 
“NAMESPACE ， 命 令 空 间 文件 ， 用 于 函数 的 访问 权限 控制 。 
“ .Rbuildignore ， 在 打包 时 ， 用 于 排除 不 参与 打包 的 文件 。 


1. 修 改 文件 DESCRIPTION 


DESCRIPTION 文件 ， 用 于 全 局 项 目 配置 ， 在 Imports 选 项 中 定义 了 5 个 包 的 依赖 ， 并 增加 LazyData 的 选项 。 


Package: chinaWeather 
Type: Package 
Title: a visualized package for china Weather 
Version: 0.1 
AuthorsQR: "Dan Zhang «bsspirit6gmail.com» [aut, cre]" 
Description: a visualized package for china Weather 
Depends: 
R (>= 3.1.1) 
Imports: 
RCurl, 
XML, 
maptools, 
RColorBrewer, 
stringi 
LazyData: TRUE 
License: GPL-2 
Date: 2014-09-28 


2. 修 改 文件 NAMESPACE 


NAMESPACE 文 件 用 于 函数 的 访问 控制 ， 我 们 先 手动 定义 需要 输出 的 函数 ， 稍 后 运行 roxygen2 包 的 document () 函数 ，NAMESPACE 文 件 会 自动 更 新 。 


export (drawTemperature) 
export (filename) 

export (getCityInfo) 

export (getWOEIDByCity) 
export (getWeather) 

export (getWeatherByCity) 
export (getWeatherFromYahoo) 


3. 新 建文 件 .Rbuildignore 


在 打包 的 时 候 ， 可 以 排除 不 相关 的 文件 ， 比 如 metadata 目 录 和 .9gitignore 文 件 等 。 


.gitignore 

dist 

metadata 
^.*A.Rproj$ 

^N. RprojN.user$ 
README* 

NEWS* 


我 们 把 R 语 言 代码 、 函 数 注释 和 配置 文件 ， 都 修改 完成 了 ， 下 面 开始 调试 程序 。 

54.5 ”调试 程序 
devtools 包 的 工具 函数 ， 调 试 程序 还 是 比较 简单 的 。 

> library (devtools) # 加 载 devtools 包 

> load all ("/home/conan/R/chinaWeather") # 加 载 chinaWeather 项 目 

Loading chinaWeather 

> data (package="chinaWeather") # 查看 chinaWeather 的 数据 集 

Data sets in package 'chinaWeather': 

WOEID 

chinaMap 

props 

weather20141001 


调用 weather20141001 测 试 数据 集 ， 画 出 2014 年 10 月 01 日 的 白天 气温 静态 


D 


> date«-as.Date (as.character (20141001) , format = "%Y%m%d") 
> drawTemperature (weather20141001, date-date) 


i 


再 画 出 2014 年 10 月 01 日 的 英文 的 夜间 气温 图 。 


> drawTemperature (weather20141001, type-'low', date-date, lang-'en') 


生成 的 可 视 化 


网 


片 ， 完 全 符合 我 们 的 要 求 。 这 里 偷懒 一 下 ， 暂 时 跳 过 单元 测试 了 。 之 前 我 们 在 代码 上 已 经 加 了 注释 ， 接 下 来 通过 roxygen2 包 生成 文档 。 


> library (roxygen2) 

» roxygenize ("/home/conan/R/chinaWeather") 

First time using roxygen2 4.0. Upgrading automaticallyhttp://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
Writing NAMESPACE T 
Writing chinaWeather-package.Rd 

Writing WOEID.Rd 

Writing chinaMap.Rd 

Writing props.Rd 

Writing weather20141001.Rd 

Writing filename.Rd 

Writing getWOEIDByCity.Rd 

Writing getCityInfo.Rd 

Writing getWeatherFromYahoo.Rd 

Writing getWeatherByCity.Rd 


Writing getWeather.Rd 
Writing getColors.Rd 
Writing drawBackground.Rd 
Writing drawDescription.Rd 
Writing drawLegend.Rd 
Writing drawTemperature.Rd 


文件 NAMESPACE 也 被 同时 更 新 了 ， 通 过 自动 化 的 方式 ， 我 们 又 可 以 少 维护 一 个 文件 了 。 运 行 一 切 正常 ， 最 后 就 是 程序 打包 。 


54.6 程序 打包 


我 们 把 用 于 打包 的 程序 放 到 dist 目 录 中 ， 新 建 dist 目 录 。 


~ mkdir /home/conan/R/chinaWeather/dist 4 新 建 目 录 dist 


1. 程 序 打包 


执行 打包 函数 build () ， 它 存在 于 dist 上 有 目录。 


> build ("/home/conan/R/chinaWeather", path-"dist") 

'/usr/lib/R/bin/R' --vanilla CMD build '/home/conan/R/chinaWeather' --no-manual --no-resave-data 

* checking for file '/home/conan/R/chinaWeather/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
* preparing 'chinaWeather': 

* checking DESCRIPTION meta-information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

* checking for LF line-endings in source and make files 

* checking for empty or unneeded directories 

* looking to see if a 'data/datalist' file should be added 

* building 'chinaWeather 0.1.tar.gz' 

[1] "dist/chinaWeather 0.1.tar.gz" 


在 本 地 安装 chinaWeather 包 。 


~ R CMD INSTALL dist/chinaWeather 0.1.tar.gz 

* installing to library '/home/conan/R/x86 64-pc-linux-gnu-library/3.1' 
* installing *source* package 'chinaWeather' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... 
** R 

** data 

*** moving datasets to lazyload DB 

** inst 

** preparing package for lazy loading 

** help 

*** installing help indices 

** building package indices 

** testing if installed package can be loaded 

* DONE (chinaWeather) 


加 载 chinaWeather 包 ， 下 载 当 天 的 天 气 数据 ， 并 可 视 化 输出 2014 年 10 月 05 日 时 时 天 气 情 况 。 


> library (chinaWeather) 

> data«-getWeather (lang-'zh') 

"2151330 ==> 8 19 28 32 NA 1023.5 0" 
"2151849 17 25 34 51 9.99 1015.92 0" 
"2159908 9 19 30 35 9.99 1015.92 0" 
"20070171 > 16 26 28 60 NA 1021.7 0" 


"2141166 ==> 0 14 34 22 9.99 1015.92 0" 
"2137321 2 16 30 27 9.99 1015.92 2" 
"2148332 6 18 28 35 9.99 1015.92 0" 
"2149760 3 15 30 31 9.99 1015.92 0" 
"2171287 9 22 34 27 9.99 1015.92 2" 
"26198317 一 > 9 18 34 55 9.99 1015.92 2" 


"2145605 6 21 32 39 NA 812.73 0" 
"2138941 3 19 32 34 NA 745.01 0" 
"2157249 12 26 32 44 NA 1022 0" 
"2150551 8 21 32 29 16 1022.7 0" 
"2172736 13 24 20 64 1.5 1015.92 0" 
"2168327 9 21 32 44 15 1022.3 0" 
"2154547 6 20 34 26 9.99 1015.92 2" 
"2127866 15 26 34 42 9.99 1015.92 2" 
"2163866 17 28 28 55 4.01 1019.8 0" 
"26198213 ==> 17 28 34 33 9.99 1015.92 0" 


"2137081 14 25 30 54 9.99 1015.92 2" 
"2158433 一 > 18 28 30 37 9.99 1015.92 2" 
"2146703 11 22 28 53 9.99 1015.92 2" 


"2160693 
"2166473 
"26198235 
"2132574 
"26198151 


8 20 30 49 9.99 1015.92 2" 
19 29 30 74 9 982.05 2" 

> -1 16 32 20 NA 643.41 0" 
16 25 34 39 9.99 1015.92 0" 
> 19 28 30 40 NA 1018.4 0" 


"2161838 20 31 34 31 9.99 982.05 0" 
"2139963 18 27 34 42 9.99 982.05 2" 
"2306179 ==> 23 27 28 51 9.99 982.05 0" 
"2162779 23 28 30 66 9.99 982.05 2" 
"24865698 23 29 30 38 9.99 982.05 0" 
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"20070017 » 25 29 34 48 9.99 982.05 2" 
> drawTemperature (data, date-Sys.Date () ) 


2.check 检 查 


打包 过 程 一 切 正常 ， 接 下 就 是 check () 函数 检查 。 从 check () 函数 的 输出 来 看 ， 我 们 顺利 地 通过 了 检查 ， 但 其 实 程序 调试 的 过 程 中 遇 到 了 很 多 问题 ， 是 一 点 一 点 花 时 间 解 决 的 。 


> check ("/home/conan/R/chinaWeather") 4 执行 check 检 查 

Updating chinaWeather documentation 

Loading chinaWeather 

'/usr/lib/R/bin/R' --vanilla CMD build '/home/conan/R/chinaWeather' --no-manual --no-resave-data 

* checking for file '/home/conan/R/chinaWeather/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


* preparing 'chinaWeather': 

* checking DESCRIPTION meta-information http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
* checking for LF line-endings in source and make files T 

* checking for empty or unneeded directories 

* looking to see if a 'data/datalist' file should be added 

* building 'chinaWeather 0.1.tar.gz' 

'/usr/lib/R/bin/R' --vanilla CMD check '/tmp/Rtmp3YI3Ar/chinaWeather 0.1.tar.gz' --timings 

* using log directory '/tmp/Rtmp3YI3Ar/chinaWeather.Rcheck' 

* using R version 3.1.1 (2014-07-10) 

* using platform: x86 64-pc-linux-gnu (64-bit) 

* using session charset: UTF-8 

* checking for file 'chinaWeather/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
* checking extension type http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... Package 

* this is package 'chinaWeather' version '0.1' 

* checking package namespace information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
* checking package dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

* checking if this is a source package http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

* checking if there is a namespace http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

* checking for executable files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

* checking for hidden files and directories http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncaompressed/15294/OEBPS/Text/... OK 
* 


checking for portable file names http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 


checking for sufficient/correct file permissions http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking whether package 'chinaWeather' can be installed http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking installed package size http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking package directory http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking DESCRIPTION meta-information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking top-level files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking for left-over files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking index information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking package subdirectories http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking R files for non-ASCII characters http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking R files for syntax errors http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking whether the package can be loaded http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking whether the package can be loaded with stated dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 
checking whether the package can be unloaded cleanly http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 
checking whether the namespace can be loaded with stated dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/ 
checking whether the namespace can be unloaded cleanly http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking loading without being on the library search path http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 
checking dependencies in R code http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking S3 generic/method consistency http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking replacement functions http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking foreign function calls http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking R code for possible problems http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking Rd files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking Rd metadata http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking Rd line widths http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking Rd cross-references http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking for missing documentation entries http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking for code/documentation mismatches http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking Rd Nusage sections http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking Rd contents http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking for unstated dependencies in examples http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking contents of 'data' directory http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking data for non-ASCII characters http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking data for ASCII and uncompressed saves http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


+O EOE OEE OEO OE OROROORO EOE EOE OE EOE EOE OEE EOE OE EOE OE OE EOE + 


checking examples http://www.hzcourse.com/resource/readBook?path=/openresources/teach_ebook/uncompressed/15294/0EBPS/Text/... OK 
checking PDF version of manual http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
3.Github 上 传 


最 后 ， 把 项 目 代码 上 传 到 Github 中 ， 在 Github 中 开源 发 布 。 


~ git add .~ git commit -m 'app- git push origin app 
To https: //github.com/bsspirit/chinaWeatherDemo.git 
* [new branch] app -> app 


项 目的 访问 地 址 为 https://github.com/bsspirit/chinaWeatherDemo/tree/app， 感 兴趣 的 用 户 可 以 自行 查看 源 代码 。 
4. 从 Github 安 装 chinaWeatherDemo 项 目 


我 们 把 代码 上 传 到 Github 的 同时 ， 就 完成 了 在 Github 上 发 布 项 目 ， 用 户 可 以 通过 devtools 包 从 Github 安 装 项 目 。 


> library (devtools) # 加 载 devtools 包 
> install github ("bsspirit/chinaWeatherDemo", ref="app") # 安装 项 目 ， 配 置 app 分 支 
Downloading github repo bsspirit/chinaWeatherDemo@app 
Installing chinaWeather 
'/usr/lib/R/bin/R' --vanilla CMD INSTALL '/tmp/RtmpTkR2Sd/devtools8435b61dfe5/bsspirit- 
chinaWeatherDemo-54e36d4' V 

-—-library-'/home/conan/R/x86 64-pc-linux-gnu-library/3.1' --install-tests 

* installing *source* package 'chinaWeather' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... 


R 
** data 
** inst 
** preparing package for lazy loading 
** help 
*** installing help indices 
** building package indices 
** testing if installed package can be loaded 
* DONE (chinaWeather) 
Reloading installed chinaWeather 


到 此 为 止 ， 整 个 项 目 关于 R 语 言 的 程序 开发 部 分 ， 就 全 都 完成 了 ， 接 下 来 就 是 PHP 的 部 分 了 。 由 于 本 书 是 一 本 R 语 言 的 图 书 ， 所 以 用 PHP 构 建 微 博 应 用 的 内 容 请 参考 笔者 的 博客 ， 将 不 在 本 书 中 介绍 。 


第 6 章 Ri 语言 游戏 之 旅 


本 章 把 R 语 言 应 用 到 了 游戏 领域 ， 虽 然 R 语 言 并 不 真正 适合 做 游戏 ， 但 是 游戏 中 的 各 种 算法 用 R 语 言 实现 却 是 既 轻 巧 又 简单 。 在 游戏 开发 的 过 程 中 ， 综 合 运 用 了 本 书 的 各 章 知识 点 ， 包 括 环境 空间 、 面 向 
对 象 、 数 学 计算 、R 包 开发 、 可 视 化 编程 等 ， 从 而 读者 可 以 更 深入 地 体会 到 R 语 言 编程 的 精髓 和 无 限 广阔 的 应 用 前 景 。 


61 R 语 言 键盘 和 鼠标 事件 


问题 


R 语 言 中 如 何 实现 键盘 和 和 鼠标 交互 ? 
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R 语 言 键 盘 和 鼠标 事件 
http://blog.fens.me/r-keyboard-mouse/ 


在 使 用 R 语 言 的 过 程 中 ， 很 多 的 技术 点 会 被 我 们 忽略 ， 这 些 经 常 被 忽略 的 技术 点 大 都 和 数据 无 关 。 但 反 过 来 讲 ， 如 果 你 能 掌握 这 些 技术 点 ， 你 开发 的 R 语 言 应 用 会 让 人 觉得 Amazing! 本 节 我 们 就 来 介绍 
一 下 RR 语言 的 键盘 和 和 饼 标 事件 。 


61.1 R 语 言 图 形 事件 


R 语 言 中 ， 应 用 最 广 的 一 类 功能 是 画图 ， 我 们 会 经 常 使 用 R 语 言 作 图 的 函数 ， 包 括 plot () , barplot () , points () , lines () 等 。 每 次 调用 plot () 函数 ，R 语 言 的 运行 环境 都 会 启动 一 个 新 的 图 形 
设备 (graphics device) 。 这 个 新 打开 的 图 形 设 备 ， 除 了 会 显示 我 们 定义 的 图 形 ， 还 内 置 了 一 套 事件 管理 器 ， 可 以 监听 键盘 和 鼠标 事件 ， 实 现 与 图 形 设备 的 通信 。 这 个 事件 管理 器 在 grDevices 包 中 定义 ， 
并 作为 当前 环境 的 父 环境 应 用 于 用 户 环境 空间 中 ， 关 于 环境 空间 的 解释 ， 请 参考 3.2 节 。 


试想 一 下 ， 如 果 画 图 程序 可 以 实现 与 鼠标 和 键盘 通信 ， 那 么 静态 图 片 也 就 可 以 与 用 户 进行 交互 了 。 掌 握 这 个 功能 ，R 语 言 将 不 仅仅 用 于 离线 分 析 ， 还 可 以 用 来 做 实时 应 用 、 聊 天 工具 或 者 是 游戏 。 接 下 
来 ， 就 让 我 们 开始 了 解 一 下 R 语 言 的 图 形 事件 APl。 


网 


6.1.2 ”图 形 事件 APl 


R 语 言 中 图 形 事 件 API 函 数 有 4 个 : 


ES 


* setGraphicsEventHandlers， 注 册 图 形 事 件 ， 包 括 键盘 事件 和 和 鼠标 事件 GET, HG, 5) o. 


- getGraphicsEvent， 启 动 图 形 事件 监听 器 ， 开 始 监 听 。 


“setGraphicsEventEnv， 设 置 图 形 设备 和 环境 空间 ， 默 认为 当前 图 形 设备 和 当前 环境 空间 。 


- getGraphicsEventEnv， 获 取 图 形 设备 ， 默 认为 当前 图 形 设 备 。 


在 图 形 设备 中 绑 定 鼠标 和 键盘 事件 ， 我 们 就 需要 通过 setGraphicsEventHandlers () 函数 ， 把 键盘 和 鼠标 事件 注册 到 图 形 设备 中 。 首 先 ， 我 们 来 看 这 个 函数 的 定义 。 
> setGraphicsEventHandlers 
function (which = dev.cur () , http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/.. 
setGraphicsEventEnv (which, as.environment (list (http://www.hzcourse.com/resource/readBook?path-/openresources/teach « ebook/ancompressed/15294/OEBPS/Text,. E. 


<bytecode: 0x000000000b321920> 
<environment: namespace: grDevices> 


通过 定义 我 们 只 能 看 到 setGraphicsEventHandlers () 又 调用 了 setGraphicsEventEnv ( 


来 设置 图 形 设备 ， 而 setGraphicsEventHandlers () 的 参数 都 用 “…” 隐 藏 了 。 


下 面 查 看 getGraphicsEvent () 函数 的 定义 。 发 现 getGraphicsEvent () 函数 的 参数 可 上 件 绑 定 ， 并 且 getGraphicsEvent () 的 参数 ， 实 际 上 是 用 来 传 给 setGraphicsEventHandlers () 函数 


> getGraphicsEvent 


function (prompt = "Waiting for input", onMouseDown = NULL, onMouseMove = NULL, 


onMouseUp = NULL, onKeybd = NULL, consolePrompt prompt) 
{ 
if (! interactive () ) 
return (NULL) 
if (! missing (prompt) || ! missing (onMouseDown) || ! missing (onMouseMove) || 


! missing (onMouseUp) || ! missing (onKeybd) ) { 
setGraphicsEventHandlers (prompt = prompt, onMouseDown = onMouseDown, 
onMouseMove = onMouseMove, onMouseUp = onMouseUp, 


onKeybd = onKeybd) 
} 
.External2 (C getGraphicsEvent, consolePrompt) 


} 
<bytecode: 0x0000000005c4bd40> 
<environment: namespace: grDevices> 


各 参数 说 明 如 下 : 

- prompt， 文 字 提 示 

“ consolePrompt， 在 终端 中 的 文字 提示 
:onMouseDown， 和 鼠标 事件 ， 按 下 鼠标 按键 
:onMouseUp， 鼠 标 事件 ， 释 放 鼠 标 按键 

' onMouseMove， 鼠 标 事件 ， 鼠 标 移动 


“ onKeybd， 键 盘 事 件 ， 按 下 键盘 


这 样 ， 通 过 getGraphicsEvent () 函数 的 封装 ， 我 们 可 以 绑 定 鼠标 事件 和 键盘 事件 的 操作 了 。 


61.3 ”键盘 事件 
说 完 知识 点 和 AP1， 下 面 我 们 就 要 动手 写 点 程序 了 。 本 节 的 系统 环境 是 : 
* Windows 7 64bit 
- R: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 


我 们 先 来 做 一 个 键盘 事件 的 小 程序 ， 要 求 如 下 : 


(1) 利用 R 语 言 画 图 ， 根 据 键盘 输入 显示 对 应 的 文字 。 


(2) 每 次 按键 盘 ， 输 出 一 个 字母 在 屏幕 上 面 。 


(3) 按 ctrl+C 时 ， 停 止 键盘 事件 。 


应 用 截图 如 图 6-1 所 示 。 


R] 


6-1 中 ， 左 边 为 R 语 言 程序 后 台 ， 每 次 键盘 输入 ， 打 印 一 行 日 志 ， 右 边 图 形 设置 中 间 的 文字 会 跟着 变化 。 


在 


网 


注 程序 不 能 在 RStudio 中 运行 ， 必 须 在 命令 行 窗口 运行 。 


R 语 言 代 码 实 现 如 下 : 


> letter<-function () { + 字母 工具 
draw«-function (label-'', x-0, y=0) { LÀ 
plot (x, y, type-'n') 
text (x, y, label-label, cex-5) 
} 
keydown<-function (K) { # 键盘 事件 
if (K == "ctrl-C") return (invisible (1) ) 
print (K) 
draw (K) 
l 
draw () # 画图 
getGraphicsEvent (prompt-"Letter Tool", onKeybd = keydown) # 注册 键盘 事件 ， 启 动 监听 


V+ 十 十 十 十 十 十 十 十 十 十 十 


} 
letter () # 启 动 程序 


E Rterm (64-bit) GITHIRO 
letter) 文件 ”历史 里 设 大 小 


Waiting for input 
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vg 
vg 
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"ctrl-FE'" 


图 6-1 键盘 事件 


这 个 小 功能 ， 实 现代 码 还 是 比较 简单 的 。 接 下 来 ， 我 们 加 上 鼠标 的 事件 ， 做 一 个 稍微 复杂 点 的 例子 。 


6.1.4 ”鼠标 事件 


R 语 言 中 ， 图 形 设备 的 鼠标 事件 ， 包 括 3 种 类 型 ， 即 鼠标 移动 、 鼠 标 按 下 ( 左 键 、 右 键 、 滚 轮 ) 、 鼠 标 释 放 。 我 们 设计 一 个 应 上 


， 要 求 如 下 : 


网 


(1) 利用 R 语 言 画 


， 根 据 鼠 标 事件 指定 图 形 的 位 置 和 形状 。 


(2) 每 次 移动 鼠标 ， 左 下 角 输 出 鼠标 所 在 的 坐标 ， 同 时 一 个 默认 的 图 形 随 鼠标 移动 。 


(3) 当 鼠 标 按 下 时 ， 会 在 当前 坐标 出 现 一 个 图 形 ， 左 键 对 应 正方 形 ， 滚 轮 对 应 用 圆 形 ， 右 键 对 应 三 角形 。 


(4) 按 q 时 ， 停 止 监听 事件 。 


应 用 截图 如 图 6-2 所 示 。 
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图 6-2 ”鼠标 事件 
代码 实现 如 下 : 
> mouse «- function () { # 和 鼠标 事件 应 用 
十 par (mai-rep (0, 4) , oma-rep (0, 4) ) # 设置 画布 无 边 
十 ps«-data.frame (x-c (0.5) , y=c (0.5) , col=c (2) , pchec (15) ) # 初始 化 的 点 
十 draw«-function (x-0, y-0) { # X，Y 为 鼠标 坐标 
十 , ylim=c (0, 1) , type-'n', xaxs-"i", yaxs-"i") 
n ' ") # 水 平 线 
+ abline (v=0.5, col-"gray60") REA 
* points (ps$x, ps$y, pch-ps$pch, cex-2, col-ps$col) # 实 
+ points (x, y, pch-15, cex=2, col=colors () [ps$coll]) # 
十 text (0.25, 0.015, label-paste (x, y, sep-", ") ) # 鼠标 坐标 
十 l 
+ # 鼠标 按键 监听 : 当 鼠 标 按键 ， 会 增加 一 个 实 点 
十 # buttons，0 是 左 键 ,1 是 滚轮 ，2 是 右键 
十 mouseDown <- function (buttons, x, y) { 
* print (paste ("down", buttons, x, E ) 
十 shape«-15 # 形状 设置 
十 if (buttons--1) shape«-16 
十 if (buttons--2) shape<-17 
* ps««-rbind (ps, data.frame (x=c (x) , y=c (y) , pch-c (shape) , col=round (runif (1, 2, 500) ) ) ) 
# 增加 实 点 
十 draw (x, y) 
十 
十 mouseMove <- function (buttons， Xe y) # 鼠标 移动 监听 
十 print (paste ("move", buttons, x, E^ ) 
十 draw (x, y) 
本 
十 mouseup <- function (buttons, x, y) { # 鼠标 按键 释放 监听 
* print (paste ("up", buttons, x, y) ) 
* draw (x, y) 
十 
十 keydown «- function (key) * 键盘 按键 监听 
+ if (key == "q") return (invisible (1) ) 
+ } 
+ draw () + 画 初 始 坐标 
* getGraphicsEvent (prompt-"mouse", onMouseDown-mouseDown, onMouseMove-mouseMove, 
onMouseUp-mouseup, onKeybd-keydown) # 注册 事件 
+} 
> mouse () # 启动 程序 


件 监 


下 一 节 ， 让 我 们 来 动手 做 个 游戏 吧 。 


通过 对 R 语 言 图 形 设备 的 村 


监听 ， 我 们 就 可 以 轻松 实现 鼠标 和 键盘 与 程序 的 交互 了 ， 是 不 是 很 有 意思 呢 ! 


6.2” 贪 食 蛇 游戏 入 门 


问题 


如 何 用 R 写 贪 食 蛇 游戏 ? 


mum 仿 食 蛇 游 戏 入 | 


用 有 语言 进行 统计 分 析 不 神奇 ， 用 R 语 言 做 分 类 算法 不 神奇 ， 用 R 语 言 做 可 视 化 也 不 神奇 ， 你 见 过 用 R 语 言 做 游戏 的 吗 ? 本 节 将 带 你 进入 R 语 言 的 游戏 开发 ， 用 有 语言 实现 贪 食 蛇 游戏 。 


贪 食 蛇 是 一 个 产生 于 20 世 纪 70 年 代 中 后 期 的 计算 机 游戏 。 此 类 游戏 在 20 世 纪 90 年 代 由 于 一 些小 屏幕 设备 引入 而 再 度 流行 ， 在 现在 的 手机 上 基本 都 可 安装 这 个 小 游戏 。 在 游戏 中 ， 玩 家 操控 一 条 细 长 的 直 
线 蛇 ， 它 会 不 停 前 进 ,玩家 只 能 操控 蛇 的 头 部 朝向 (上 下 左右 ) ， 一 路 拾 起 触 磁 到 之 物 (水 果 ) ,并 要 避免 触 磁 到 自身 或 者 其 他 障碍 物 。 每 次 贪 食 蛇 吃 掉 一 个 食物 ， 它 的 身体 便 增长 一 些 。 吃 掉 一 些 食物 后 
会 使 蛇 的 移动 速度 逐渐 加 快 ， 让 游戏 的 难度 渐渐 变 大 。 游 戏 设置 四 面 都 有 墙 ， 并 且 不 可 以 穿越， 蛇 头 碰 到 墙 或 障碍 物 时 ， 游 戏 结束 。 以 游戏 过 程 吃 到 的 水 果 数 量 来 计 分 。 贪 食 蛇 游戏 ， 在 各 种 设备 上 都 有 实 
现 ， 已 经 有 很 多 种 版 本 ， 如 图 6-3 所 示 。 
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图 6-3 贪 食 蛇 游 戏 介绍 


要 开发 这 款 游戏 ， 我 们 应 该 如 何 动手 呢 ? 首先 ， 我 们 需要 从 软件 开发 的 角度 ， 对 这 款 游戏 进行 需求 分 析 ， 列 出 游戏 的 规则 ， 并 设计 业务 流程 ， 给 出 游戏 的 原型 ， 验 证 是 否 可 行 。 


贪 食 蛇 游戏 ， 应 该 有 3 个 场景 : 开机 场景 、 游 戏 场景 和 结束 场景。 
“ 开机 场景 : 启动 程序 ， 在 游戏 开始 前 ， 给 用 户 做 准备 ， 并 提示 如 何 操作 游戏 。 
“ 游戏 场景 : 游戏 运行 中 的 场景 。 


“ 结束 场景 : 当 用 户 胜利 、 失 败 或 退出 时 的 场景 ， 并 提示 用 户 在 游戏 中 的 得 分 。 


开机 场景 和 结束 场景 比较 简单 ， 不 再 解释 。 游 戏 场景 是 整个 游戏 的 核心 ， 包 括 一 块 画布 、 一 条 蛇 、 一 个 蛇 头 、 一 个 不 定 长 的 蛇 尾 、 一 个 水 果 、 边 界 和 障碍 物 。 


下 面 详细 列 出 游戏 进行 时 的 规则 。 


(1) 开始 游戏 后 ， 用 户 可 以 通过 上 (up) 、 下 (down), Æ (left) 、 右 (right) 键 来 操作 蛇 头 ， 控 制 蛇 的 前 进 方向 ， 还 可 以 按 q 键 直接 游戏 失败 ， 其 他 的 键盘 操作 无 效 。 


(2) 蛇 头 用 蓝 色 标识 ， 蛇 尾 用 灰色 标识 ， 水 果 用 红色 标识 ， 障 碍 物 用 黑色 标识 。 


(3) 当 蛇 头 移动 到 水 果 的 位 置 后， 表示 蛇 吃 到 了 水 果 ， 蛇 尾 的 长 度 加 1。 水 果 会 在 下 一 次 蛇 头 移动 后 ， 在 空 路 径 上 自动 生成 。 


(4) 游戏 画布 的 外 围 是 边界 ， 当 蛇 头 移动 到 画布 看 不 到 的 位 置 ， 则 表示 蛇 头 撞 到 边界 ， 游 戏 失败 。 


(5) 游戏 画面 中 ， 有 一 些 黑色 障碍 物 ， 当 蛇 头 磁 到 障碍 物 ， 游 戏 失败 。 
(6) 当 蛇 头 碰 到 蛇 尾 时 ， 游 戏 失败 。 
3. 业 务 流程 


我 们 把 游戏 设 定 为 3 个 场景 ， 那 么 游戏 场景 的 切换 流程 ， 如 图 6-4 所 示 。 
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程序 退出 


图 6-4 ”业务 流程 定义 
: 打开 程序 时 ， 用 户 首先 看 到 开机 场景 ， 按 任意 键 后 进入 游戏 场景。 

“ 在 游戏 场景 ， 当 游戏 失败 时 ， 进 入 结束 场景 ; 按 q 键 ， 则 直接 游戏 失败 。 

“ 在 结束 场景 ， 按 空格 回 到 开机 场景 ; 按 q 键 ， 则 直接 能 退出 程序 。 

4. 游 戏 原型 


我 们 先 要 设计 出 3 个 游戏 场景 的 界面 ， 作 为 游戏 研发 前 的 原型 设计 。 左 边 为 开机 场景 ， 中 间 是 游戏 场景 ， 右 边 是 结束 场景 ， 如 图 6-5 所 示 。 


Snake Game Game Over 


Any keyboard to start Space to restart, q to quit. 


Up,Down,Left,Rigth to control direction | Congratulations! You have eat 17 fruits! 


图 6-5 贪 食 蛇 游 戏 场景 


接 下 来 ， 我 们 根据 游戏 原型 设计 ， 用 程序 来 画 出 整个 游戏 的 场景 。 


62.3 ”程序 设计 


通过 上 面 的 功能 需求 分 析 ， 我 们 已 经 非常 清楚 地 了 解 贪 食 蛇 游戏 的 各 种 规则 和 功能 需求 。 接 下 来 ， 我 们 要 把 需求 分 析 中 的 业务 语言 ， 通 过 技术 语言 重新 描述 ， 并 考虑 非 功能 需求 ， 以 及 R 语 言 相关 的 技术 


Bera: 


1 .游戏 场景 


我 们 让 每 个 场景 对 应 于 一 块 画布 ， 即 每 个 场景 对 应 一 个 内 存 结构 。 

“ 开机 场景 ， 是 静态 的 ， 我 们 可 以 提前 生成 这 块 画布 并 存储 起 来 ， 也 可 以 当 用 户 切 的 时 再 临时 生成 ， 性 能 开销 不 大 。 

:游戏 场景 ， 是 动态 的 ， 每 进行 一 次 用 户 的 交互 行为 或 按时 间 剧 新 时 ， 都 需要 重新 绘制 画布 ， 让 游戏 场景 通过 绑 定 事件 来 生成 画布 。 由 于 用 户 会 频繁 操作 ， 因 此 性 能 开销 比较 大 。 
: 结束 场景 ， 是 动态 的 ， 在 结束 场景 会 显示 当 次 游戏 的 得 分 ， 需 要 在 切换 时 临时 生成 。 


2 .游戏 对 象 


在 游戏 进行 中 ， 会 产生 很 多 的 对 象 ， 如 上 文中 提 到 的 画布 、 蛇 、 水 果 等 。 这 些 对 象 都 需要 在 内 存 中 进行 定义 并 匹配 到 R 程 序 的 数据 类 型 。 


画布 对 象 的 详细 描述 : 

“ 画布 : 用 纸 阵 来 描述 ， 画 布 中 每 个 小 方块 对 应 到 矩阵 中 一 个 数字 。 

“ 画布 大 小 : 画布 的 长 和 宽 ， 分 别 对 应 两 个 数字 变量 。 

: 画布 坐标 : 用 于 画布 内 小 格子 的 定位 ， 从 左 到 右 横 坐 标 是 1 到 20， 从 底 到 顶 纵 坐标 为 1 到 20。 
AFRA: 用 于 画布 内 小 格子 的 定位 ， 按 从 左 到 右 ， 从 底 到 顶 的 顺序 ， 为 1 到 400。 


: 方 格 : 在 画布 里 最 小 的 单位 是 方 格 ， 按 照 画 面 的 比例 ， 设 置 方 格 的 大 小 。 


和 矩阵 描述 的 画面 对 象 ， 如 


6-6 所 示 。 
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蛇 对 象 的 详细 描述 。 
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H6-6 d xb XA 


“ 蛇 头 : 用 一 个 向 量 来 描述 ， 只 有 一 个 方 格 。 游 戏 开始 时 ， 起 点 位 置 为 坐标 (2，2) ， 黑 认 蛇 头 向 上 移动 ， 用 户 打开 界面 显示 位 置 为 0,3. 
A: 用 数据 框 来 描述 ， 存 储 不 定 长 度 的 坐标 向 量 。 游 戏 开 始 时 ， 蛇 尾 长 度 是 0。 
水 果 对 象 的 详细 描述 。 
“水果: 用 一 个 向 量 来 描述 ， 只 有 一 个 方 格 。 游 戏 开始 时 ， 随 机 出 现在 空 的 格子 上 。 当 水 果 被 吃 掉 后 ， 会 在 空 的 格子 上 再 随机 生成 一 个 水 果 。 
边界 和 障碍 物 描述 。 
“ 边界 : 无 内 存 描 述 ， 通 过 计算 判断 。 当 蛇 头 坐标 超过 和 天 阵 坐标 时 ， 触 发 边界 碰撞 事件 。 
“ 障碍 物 : 用 数据 框 来 描述 ， 存 储 不 定 长 度 的 坐标 向 量 。 


3. 游 戏 事件 


游戏 过 程 中 ,会 有 3 种 游戏 事件 ， 键 盘 事 件 、 时 间 事 件 和 碰撞 事件 。 


“ 键盘 事件 : 全 局 事件 ， 用 户 通过 键盘 输入 而 触发 的 事件 ， 比 如 上 下 左右 控制 蛇 的 移动 方向 。 


:时间 事件 : 全 局 事件 ， 系 统计 时 以 每 0.2 秒 触发 一 次 时 间 事 件 ， 比 如 蛇 头 每 0.2 秒 的 移动 一 格 。 


:碰撞 事件 : 当 蛇 头 移动 时 ， 与 非 空 格子 碰撞 产生 的 事情 ， 比 如 ， 吃 到 水 果 ， 蛇 头 撞 到 蛇 尾 。 


通常 情况 ， 上 面 3 种 事件 分 别 有 3 个 线程 来 控制 。 但 由 于 R 语 言 本 身 是 单线 程 的 设计 ， 而 且 不 支持 异步 调用 ， 因 此 我 们 无 法 同时 实现 上 面 的 3 个 事件 监听 。 取 一 种 折 中 方案 为 ， 全 局 监听 键盘 事件 ， 通 过 键 
盘 事 件 触发 碰撞 事件 进行 碰撞 检查 ， 忽 略 时 间 事 件 。 


4 游戏 控制 


在 游戏 进行 中 ， 每 个 状态 我 们 都 需要 进行 控制 的 。 比 如 ， 什 么 时 候 生 成 新 的 水 果 ， 什 么 时 候 增加 一 节 尾巴 ， 什 么 时 候 游戏 结束 等 。 通 过 定义 控制 函数 ， 可 以 方便 我 们 管理 游戏 运行 中 的 各 种 游戏 状态 ， 
整个 游戏 程序 流程 如 图 6-7 所 示 。 


开机 场景 
stage0 
开始 游戏 
游戏 场景 变量 初始 化 
stagel keydown 
重新 开始 stu (b 


加 载 程序 


启动 程序 


图 6-7 贪 食 蛇 游 戏 程序 流程 


Taj 


6-7 中 每 个 方块 代表 一 个 R 语 言 函 数 定义 。 


“ run () : 启动 函数 ， 用 于 启动 游戏 程序 。 
“ keydown () : 监听 键盘 事件 ， 全 局 锁定 线程 。 
-stage0 () : 创建 开机 场景 ， 可 视 化 输出 。 


stagel () : 创建 游戏 场景 ， 可 视 化 输出 。 


-stage2 () : 创建 结束 场景 ， 可 视 化 输出 。 
init () : 打开 游戏 场景 时 ， 初 始 化 游戏 变量 。 
fuit O : 判断 并 生成 水 果 坐 标 。 

-head () : 生成 蛇 头 移动 坐标 。 


“ fail () : 失败 检查 ， 判 断 蛇 头 是 否 撞墙 或 撞 蛇 尾 ， 如 果 失 败 则 跳 过 画图 ， 进 入 结束 场景 。 


body () : 生成 蛇 尾 移动 坐标 。 


- drawTable () : 绘制 游戏 背景 。 


- drawMattix () : 绘制 游戏 矩阵 。 


通过 详细 的 游戏 程序 设计 过 程 ， 我 们 就 把 需求 分 析 中 的 业务 语言 描述 ， 变 成 了 程序 开发 中 的 技术 语言 描述 。 经 过 完整 的 设计 后 ， 最 后 就 剩 下 写 代码 了 。 


6.24 R 语 言 实现 


R 语 言 写 代码 ， 其 实 没 有 几 行 就 可 以 搞定 。 按 照 上 面 的 函数 定义 ， 我 们 把 代码 像 填空 一 样 地 写 进去 就 行 了 。 当 然 ， 在 写 代码 的 过 程 中 ， 我 们 需要 用 到 一 些 R 语 言 特性 ， 让 代码 更 健壮 。 


本 节 的 系统 环境 是 : 
* Windows 7 64bit 


- R: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 


首先 是 用 于 启动 游戏 程序 的 启动 函数 run () 。 


run<-function () ( 


par (mai-rep (0, 4) , oma-rep (0, 4) ) # 设置 全 局 画布 无 边 
e<<-new.env () + 定义 全 局 环境 空间 ， 用 于 封装 变量 
stage0 () # 启动 开机 场景 

getGraphicsEvent (prompt-"Snake Game", onKeybd-keydown) # 注册 键盘 事件 


上 面 代码 中 ， 通 过 定义 环境 空间 e 来 存储 变量 ， 可 以 有 效 地 解决 变量 名 冲突 和 变量 污染 的 问题 ， 关 于 环境 空间 的 介绍 ， 请 参考 3.2 节 和 3.3 节 。 


然后 是 keydown () ， 用 于 监听 键盘 事件 ， 全 局 锁定 线程 。 


keydown«-function (K) ( 
print (paste ("keydown: ", K, ", stage: ", e$stage) ) ; # 打印 键盘 输入 
if (e$stage--0) { # 开机 场景 
init () 
stagel () 
return (NULL) 
} 
if (e$stage==2) { + 
if (K="q") q() 
else if (K==' ') stage0 () 
return (NULL) 
} 
if (e$stage==1) { # 游戏 场景 
if (K-- "q" |( 4 按 q 键 ， 切 换 到 结束 场景 
stage2 () 
) else ( 
if (tolower (K) $in$ c ("up", "down", "left", "right") ) { 
e$lastd«-e$dir 
e$dir«-tolower (K) 
stagel () 
} 
} 
return (NULL) 


v 
AF 


束 场 景 


代码 中 ， 参 数 K 为 键盘 输入 。 通 过 对 当前 所 在 场景 与 键盘 输入 的 条 件 判断 ， 来 确定 键盘 事件 的 响应 。 在 游戏 中 ， 键 盘 只 响应 5 个 键 "up"，"down"，"left"，"right"，"q"， 分 别 对 应 “向 上 ”、 “向 
TU. "BE. "AE. “RH” WIRE 


stage0 () : 创建 开机 场景 ， 可 视 化 输出 。 


stageO«-function () ( # 开机 场景 
e$stage«-0 
plot (0, 0, xlim-c (0, 1) , ylimec (0, 1) , type-'n', xaxs-"i", yaxs-"i") 


text (0.5, 0.7, label-"Snake Game", cex-5) 

text (0.5, 0.4, label-"Any keyboard to start", cex-2, col-4) 

text (0.5, 0.3, label-"Up, Down, Left, Rigth to control direction", cex-2, col-2) 
text (0.2, 0.05, label-"Author: DanZhang", cex-1) 

text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


stage2 () : 创建 结束 场景 ， 可 视 化 输出 。 


stage2«-function () { # 结束 场景 
e$stage«-2 
plot (0, 0, xlim=c (0, 1) , ylimec (0, 1) , type-'n', xaxs-"i", yaxs-"i") 
text (0.5, 0.7, label-"Game Over", cex-5) 
text (0.5, 0.4, label-"Space to restart, q to quit.", cex-2, col-4) 
text (0.5, 0.3, label-paste ("Congratulations! You have eat", nrow (e$tail) , "fruits! ") , cex-2, col-2) 
text (0.2, 0.05, label-"Author: DanZhang", cex-1) 
text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


init () : 打开 游戏 场景 时 ， 初 始 化 游戏 变量 。 


init«-function () ( d 初始 化 环境 变量 
e««-new.env () 
e$stage«-0 # 场景 
e$width<-e$height<-20 oed 
e$stepc-1/eSwidth # 步 长 
eSm«-matrix (rep (0, e$width*eSheight) , nrow=e$width) LEG d 
e$dir«-e$lastd«-'up' E 移动 方向 
eShead<-c (2, 2) # 初始 化 蛇 头 
e$lastx«-e$lasty«-2 d 初始 化 蛇 头 上 一 个 点 
e$tail«-data.frame (x-c () , yec () ) # 初始 华 蛇 尾 
e$col fruit«-2 * 水 果 颜 色 
e$col head«-4 + 蛇 头 颜色 
e$col tail«-8 * 蛇 尾 颜色 
e$col path<-0 # 路 颜色 


上 面 代码 中 ， 初 始 化 全 局 的 环境 空间 e， 然 后 将 所 有 需要 的 变量 ， 定 义 在 e 中 。 


fruit () : 判断 并 生成 水 果 坐 标 。 


fruit () : 判断 并 生成 水 果 坐 标 。 
fruit«-function () ( # 随机 的 水 果 点 
if (length (index (e$col fruit) ) <=0) ( + 不 存在 水 果 


idx«-sample (index (e$col path) , 1) 
fx«-ifelse (idx$$e$width--0, 10, idx$$eS$width) 
fy«-ceiling (idx/e$height) 

e$m[fx, fy]«-e$col fruit 

print (paste ("fruit idx", idx) ) 

print (paste ("fruit axis: ", fx, fy) ) 


fail O : 失败 检查 ， 判 断 蛇 头 是 否 撞墙 或 撞 蛇 尾 ， 如 果 失 败 则 跳 过 画图 ， 进 入 结束 场景 。 


fail<-function () { + 失败 检查 
if (length (which (e$head«1) ) >0 | length (which (e$head>e$width) ) >0) ( # head 出 边界 
print ("game over: Out of ledge.") 
keydown ('q') 
return (TRUE) 


l 

if (e$m[e$head[1], e$head[2]]—-e$col tail) { # 蛇 头 碰 到 蛇 尾 
print ("game over: head hit tail") 
keydown ('q') 
return (TRUE) 

l 

return (FALSE) 


head () : 生成 蛇 头 移动 坐标 。 


head«-function () ( # 生成 蛇 头 坐标 
eSlastx«-eShead[1] 
eSlasty«-eShead[2] 


if (e$dir—'up') e$head[2]«-e$head[2]41 # 方向 操作 ， 向 上 移动 
j i eShead[2] «-eS$head[2] -1 # 方向 操作 ， 向 下 移动 
eShead[1]«-e$head[1]-1 E 方向 操作 ， 向 左 移动 
if (e$dir=='right') e$head[1]<-e$head[1]+1 # 方向 操作 ， 向 右 移动 
} 
body () : 生成 蛇 尾 移动 坐标 。 
body<-function () ( + 生成 蛇 头 坐标 
esm[e$lastx, e$lasty]<-0 
e$m[e$head[1], eShead[2]]«-e$col head # snake 
if (length (index (e$col fruit) ) «-0) ( # 不 存在 水 果 


e$tail«-rbind (e$tail, data.frame (x-e$lastx, y-e$lasty) ) 


} 

if (nrow (e$tail) >0) { # 如 果 有 尾巴 
eStail«-rbind (e$tail, data.frame (x-e$lastx, y=e$lasty) ) 
e$m[e$tail[1, ]$x, e$tail[1, ]$y]«-e$col path 
e$tail«-e$tail[-1, ] 
e$m[e$lastx, e$lasty]«-e$col tail 

} 

print (paste ("snake idx", index (e$col head) ) ) 

print (paste ("snake axis: ", e$head[1], e$head[2]) ) 


drawTable () : 绘制 游戏 背景 。 


drawTable«-function () ( # 画布 背景 
plot (0, 0, xlim=c (0, 1) , ylimec (0, 1) , type-'n', xaxs-"i", yaxs-"i") 
# 显示 背景 表格 


abline (h-seq (0, 1, e$step) , co 

abline (v-seq (0, 1, e$step) , co 

+ ETIE 

df<-data.frame (x=rep (seq (0, 0.95, e$step) , e$width) , y=rep (seq (0, 0.95, e$step) , each= 
e$height) , lab=seq (1, e$width*e$height) ) 

text (df$x+e$step/2, df$y+e$step/2, label-df$lab) 


"gray60") # 水 平 线 
gray60") t 垂直 线 


drawMatrix () : 绘制 游戏 矩阵 。 


drawMatrix«-function () { # 根据 矩阵 画 数 据 
idx«-which (e$m»0) 
px«- (ifelse (idx$$e$width--0, e$width, idx$$e$width) -1) /e$widtht*e$step/2 
py<- (ceiling (idx/eSheight) -1) /eS$heightte$step/2 
pxy«-data.frame (x-px, y-py, col-e$m[idx]) 
points (pxy$x, pxy$y, col-pxy$col, pch-15, cex-4.4) 


stage1 () : 创建 游戏 场景 ，stage1 () 函数 内 部 封装 了 游戏 场景 运行 时 的 函数 ， 并 进行 调用 。 


stagel«-function () { t 游戏 中 

e$stage«-1 
fruit«-function () (http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...] 
fail«-function () (http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...] 
head«-function () (http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...] 
body«-function () (http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/...] 
drawTable«-function () (http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text./ . . 
drawMatrix«-function () (http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
fruit () # 运行 函数 
head () 
if (! fail () ) { + 失败 检查 

body () 

drawTable () 

drawMatrix () 
} 


} 


# 见 fruit 

# 见 fail 

# 见 head 

* 见 body 

# 见 drawTable 
# 见 drawMatrix 


注 上面 代码 为 伪 代 码 。 


最 后 ， 是 完整 的 R 语 言 程 序 代码 。 


> init<-function () { # 初始 化 环境 变量 

* e««-new.env () 

+ e$stage<-0 PIR 

+ e$width<-e$height<-20 # 切 分 格子 

+ e$step<-1/e$width LEES 

十 e$m«-matrix (rep (0, e$width*e$height) , nrow-e$width) PEHEE 
+ e$dir<-e$lastd<-'up' E 移动 方向 

+ e$head<-c (2, 2) # 初始 蛇 头 

+ e$lastx<-e$lasty<-2 + 初始 化 蛇 头 上 一 个 点 
+ eStail«-data.frame (x=c () , y=c () ) + 初始 蛇 尾 
4 

* e$col fruit«-2 exin e 

十 e$col head«-4 # 蛇 头 颜色 

十 e$col tail«-8 iE e, 


十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 VYVVV++ 


十 十 十 十 十 VY+ 十 十 十 十 十 十 十 VY 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 


VYV+ 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 十 VVVYV+ 二 十 


e$col path<-0 
l 


index«-function (col) which (e$m--col) 


stagel«-function () ( 
e$stage«-1 


fruit«-function () ( 


# 路 颜色 


# 获得 矩阵 的 索引 值 
* 游戏 中 


# 随机 的 水 果 点 


if (length (index (e$col fruit) ) <=0) ( LES ER 
idx«-sample (index (e$col path) , 1) 


fx«-ifelse (idx$$e$width--0, 10, idx$$eSwidth) 


fy«-ceiling (idx/e$height) 
e$m[fx, fy]«-e$col fruit 


print (paste ("fruit idx", idx) ) 
print (paste ("fruit axis: ", fx, fy) ) 


$ 


fail<-function () { 


# 检查 失败 


if (length (which (e$head«1) ) >0 | length (which (e$head»e$width) ) >0) { 
+ 蛇 头 出 边界 
print ("game over: Out of ledge.") 


keydown ('q') 
return (TRUE) 
} 


if (e$m[e$head[1], e$head[2]]--e$col tail) ( + 蛇 头 碰 到 蛇 尾 
print ("game over: head hit tail") 


keydown ('q') 
return (TRUE) 
$ 


return (FALSE) 
} 


head<-function () { # 蛇 头 状态 
e$lastx<-e$head[1] 
e$lasty<-e$head[2] 
if (e$dir=='up') e$head[2]<-e$head[2]+1 # 方向 操作 


left') eShead 


H 


body«-function () { 
e$m[e$1lastx, e$lasty]«-0 


down') e$head[2]«-e$head[2]-1 
[1]«-e$head[1]-1 
'right') e$head[1]«-e$head[1]41 


+ 蛇 尾 状态 


e$m[e$head[1], e$head[2]]<-e$col head 
if (length (index (e$col fruit) ) <=0) ( # 不 存在 水 果 
e$tail<-rbind (e$tail, data.frame (x=e$lastx, y=e$lasty) ) 


} 


if (nrow (e$tail) >0) { 


# 如 果 有 尾巴 


e$tail<-rbind (e$tail, data.frame (x-e$lastx, y-e$lasty) ) 
e$m[e$tail[1, ]$x, e$tail[1, ]$y]«-e$col path 


eStail«-e$tail[-1, ] 


e$m[e$lastx, e$lasty]«-e$col tail 


J 


print (paste ("snake idx", index (e$col_head) ) ) 
print (paste ("snake axis: ", e$head[1], e$head[2]) ) 


} 


drawTable<-function () { 


plot (0, 0, xlim=c (0, 1) , ylimec (0, 1) , type-'n', xaxs="i", yaxs= 


} 


drawMatrix<-function () { 
idx«-which (e$m>0) 


t 画布 背景 


P ARIES ACE 


px«- (ifelse (idx$$e$width--0, e$width, idx$$e$width) -1) /e$widtht*e$step/2 
py<- (ceiling (idx/e$height) -1) /e$height+e$step/2 
pxy«-data.frame (x-px, y-py, col-e$m[idx]) 


points (pxy$x, pxy$y, col-pxy$col, 
} 


fruit () 

head () 

if (! fail ) ( 
body () 
drawTable () 
drawMatrix () 


} 


stage0<-function () { 


plot (0, 0, xlim=c (0, 1) , ylimec (0, 1) , type-'n', xaxs="i", yaxs 


pch-15, cex-4.4) 


# 开机 画图 


Any keyboard to start", cex-2, col-4) 


0 
0 
text (0.5, 0.3, label-"Up, Down, Left, Rigth to control direction", cex-2, col-2) 
0 
0 


e$stage«-0 

text (0.5, 0.7, label-"Snake Game", cex-5) 

text (0.5, 0.4, labe 

text (0.2, 0.05, label-"Author: DanZhang", cex-1) 
text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


} 


stage2<-function () { 
e$stage«-2 


# 结束 画图 


plot (0, 0, xlim-c (0, 1) , ylimec (0, 1) , type-'n', xaxs-"i", yaxs-"i") 


text (0.5, 0.7, labe 


Game Over", cex-5) 


text (0.5, 0.4, label-"Space to restart, q to quit.", cex-2, col-4) 
text (0.5, 0.3, label-paste ("Congratulations! You have eat", nrow (e$tail) , "fruits! ") , 


cex-2, col-2) 


text (0.2, 0.05, label-"Author: DanZhang", cex-1) 
text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


keydown«-function (K) ( 
print (paste ("keydown: 
if (e$stage--0) ( 
init () 
stagel () 
return (NULL) 


K, ", stage: 


} 


if (e$stage—2) { 
if (K"q" q0 
else if (K--' ') stage0 () 
return (NULL) 


} 


if (e$stage==1) { 
if (K "qU ( 
stage2 () 


) else { 
if (tolower (K) $in$ c ("up", 
e$lastd«-e$dir 
eSdir«-tolower (K) 
stagel () 


$ 


} 
return (NULL) 
} 


HHHHHHHHHHHHHHHHHHHHHHAHHHHHHHHHHHHHHHHE 


# 键盘 事件 
, e$stage) ) ; 
+ 开机 画面 


+ 游戏 中 


"down", "left", "right") ) ( 


> # RUN 

> AHHHHHHHHHBHHHHHHBHHHHHHHHBHHHRBHHHRHHRHHHEE 
> 

> run«-function () { 


* par (mai-rep (0, 4) , oma-rep (0, 4) ) 

十 e««-new.env () 

* stage0 () 

* getGraphicsEvent (prompt-"Snake Game", onKeybd-keydown) + 注册 事件 
+3} 

» 

> run () 

游戏 截图 见 图 6-8。 


onake Game 


Any keyboard to start 
Up,Down,Left,Rigth to control direction 


Author Danzhang hitpJ/blog.fens.me 


图 6-8” 贪 食 蛇 游戏 动画 


全 部 代码 仅仅 161 行 ， 而 有 效 代码 行 只 有 100 行 左右 ， 就 实现 了 贪 食 蛇 游 戏 。 当 然 ， 时 间 事 件 没有 实现 ， 只 因为 R 语 言 本 身 的 单线 程 机 制 ， 而 且 不 支持 异步 调用 。 正 因为 R 语 言 强 大 的 数据 处 理 能 力 和 可 视 
化 能 力 ， 让 我 们 的 程序 写 起 来 非常 简单 。 我 想 如 果 让 R 来 实现 策略 类 游戏 的 矩阵 部 分 的 计算 ， 一 定 会 非常 顺手 的 。 


有 了 贪 食 蛇 游戏 的 锥 形 ， 再 通过 面向 对 象 的 封装 ， 能 不 能 归纳 出 一 个 基于 R 语 言 游戏 的 开发 框架 呢 ? 下 一 节 将 继续 R 语 言 游戏 之 旅 ，R 语 言 游戏 框架 设计 。 


6.3 ”R 语 言 游 戏 框架 设计 
问题 


如 何 用 R 语 言 写 游戏 框架 ? 


=: 
= 


R 语 言 游 戏 框 染 设计 EÈ 


http://blog.fens.me/r-game-framework/ 


本 节 继 续 上 一 节 ， 当 我 们 完成 了 贪 食 蛇 游戏 之 后 ， 我 们 应 该 把 代码 进一步 整理 ， 抽 象 出 游戏 中 通用 的 部 分 ， 分 离 游戏 框架 代码 和 贪 食 蛇 游戏 代码 。 我 们 就 可 以 提取 出 一 个 R 语 言 的 游戏 开发 引擎 ， 当 再 开 
发 新 的 游戏 时 ， 只 要 关心 游戏 本 身 的 程序 设计 就 行 了 。 


我 们 可 以 利用 面向 对 象 的 方法 论 ， 对 贪 食 蛇 游戏 进行 抽象 整理 ， 并 实现 代码 的 面向 对 象 的 改造 。R 语 言 支 持 3 种 面向 对 象 的 编程 实现 方式 ， 我 选择 基于 RC 的 面向 对 象 编程 ， 关 于 RC 详细 使 用 请 参考 4.4 


2 


由 于 我 们 之 前 的 代码 都 是 通过 函数 来 封装 的 ， 所 以 代码 重 构 还 是 比较 简单 的 ， 只 要 把 snake 对象 的 属性 和 方法 定义 清楚 就 行 了 。 


四 | 


6-9 所 示 。 


定义 Snake 类 ， 包 括 属性 和 方法 ， 画 出 类 图 ， 如 


[ 


属性 解释 如 下 。 
.name: 游戏 的 名 字 。 


stage: 当前 的 游戏 场景 。 


“ e: 用 环境 空间 存储 游戏 中 的 变 


* width: 矩阵 的 宽 。 


“ height: 4EBE ÉJ 3. 


mi 游戏 地 图 矩阵 。 


下 面 是 方法 解释 。 


量 ，environment 类 型 。 


-initialize () : 构建 函数 ， 用 于 RC 类 的 初始 化 。 


init () : 给 stagel 场 景 初始 化 游戏 变量 。 


-fal () : 失败 检查 。 


-fruit () : 判断 并 生成 水 果 坐 标 。 


-head () : 生成 蛇 头 移动 坐标 。 


“body () : 生成 蛇 尾 移动 坐标 。 


- drawTable () 


- drawMatrix () : 


: 绘制 游戏 背景 。 


绘制 游戏 矩阵 。 


- stage0 () : 创建 开机 场景 ， 可 视 化 输出 。 


' stagel () 


-stage2 () : 创建 结束 场景 ， 可 视 化 输出 


* keydown () : 监听 键盘 事件 。 


-run () : 启动 函数 。 


2. 全 局 函数 调用 顺序 图 


接 下 来 ， 根 据 UML 规 范 画 出 顺序 | 


图 6-9 Snake 类 定义 


: 创建 游戏 场景 ，stage1 () 函数 内 部 ， 封 装 了 游戏 场景 运行 时 的 函 数 ， 并 进行 调用 。 


， 主 要 包括 全 局 函数 调 


和 stage1 场 景 游戏 环境 调 


。 全 局 函数 调 


关系 ， 如 图 


6-10 所 示 。 


游戏 全 局 调用 过 程 


ES m me] [us 


1 | | | i I 
| 启动 游戏 | ! ! i 
i i 注册 键盘 事件 | | i i 
| pe | 任意 键 ! | 
I 让 一 一 一 一 一 一 一 | 初始 化 游戏 环境 | 
I l | | I 
| | | FRR | | 
I l | l | 
I l | I | l 
: | | 
1 1 | 游戏 运行 | 
I l | | I 
I 1 i | 
l i ! fail l 
I 1 i | 
1 l | | l 
I l l | | 
I 1 i | | 
1 i | ! q i 
1 I | -— £À————— À—— 1a 
I 1 | | | 
i | space 重 新 开始 i 
1 i ! i 
I I | I 
I | | i 
1 q 退 出 游戏 ! | 
I | | I 
| ! i 
i ! i 


6-10 游戏 全 局 函数 调用 过 程 


“ 通过 run () 函数 启动 游戏 ， 进 入 stage0 场 景 ， 注 册 键 盘 事件 。 
:在 stage0 场 景 按 任意 键 切换 到 stage1 场 景 。 

-init () 初始 化 stage1 场 景 的 游戏 变量 。 

“stagel () 运行 游戏 。 

- 当 游 戏 失败 fail () 或 按 q 键 。 

“ 游戏 进行 stage2 场 景 ， 显 示 游 戏 结束 画面 。 


. 按 空格 键 回 到 stage0 重 新 开始 ， 按 q 键 退出 程序 。 


3.stage1 场 景 游戏 环境 函数 调用 顺序 图 


stage1 场 景 游戏 环境 函数 调用 关系 ， 如 图 6-11 所 示 。 


在 游戏 中 的 序列 图 


l k | 
1 


I 1 1 
he up, down, left, right | ' l : | - 
| 1 
1 一 1 1 1 i 
”| | 
| | ! | L——dw gu ! 1 

| yes ! [ 1 1 1 i 1 
» | E— —8 ' 
| | | 1 i 1 —— ! 
| | ! i | i i EL — —p 
| l ! | 1 1 | i 1 
| | | | | | | | | 
+ 一 -一 一 4 
| | Eee T 1 i T | 
1 1 : 1 | 1 I ! 
1 
| | ! | 1 
| | ! | 1 
| | ! | 1 
| ! | 1 
I 1 1 
| | 
i i 


图 6-11 游戏 stage1 场 景 函 数 调用 过 程 


“ 游戏 进入 stage1 场 景 ， 按 上 (up) 、 下 (down) 、 左 (left) 、 右 (right) 方向 键 操作 蛇 头 的 前 进 路 线 。 


fuit O BARE, eG EGORARUOE, UA ASNDIOR, TRIEP 


“head () 函数 ， 通 过 上 下 左右 键 的 操作 ， 进 行 蛇 头 的 移动 ， 记 录 到 矩阵 中 。 
fall () 远 数 失败 检查 ，no 未 失败 继续 ，yes 失 败 进行 stage2 场 景 。 

“body () 芳 数 ， 蛇 身体 移动 ， 记 录 到 佐 阵 中 。 

' drawTable () 函数 ， 画 出 游戏 背景 画布 。 


: drawMatrix () 函数 ， 画 出 游戏 矩阵 。 


利用 UML 的 方法 ， 通 过 类 图 和 顺序 图 的 描述 ， 我 们 就 把 贪 食 蛇 的 游戏 程序 进行 了 面向 对 象 的 设计 改造 ， 基 本 的 轮廓 已 经 呈现 出 来 了 。 不 用 着 急 去 写 代 码 ， 我 们 再 想 想 如 何 进行 游戏 框架 的 提取 。 


6.3.2 ”游戏 框架 定义 


设计 一 个 完整 、 易 用 、 有 良好 扩展 的 游戏 框架 是 比 难 的 ， 但 我 们 可 以 基于 贪 食 蛇 的 游戏 ， 一 步 一 步 来 做 抽象 。 抽 象 过 程 就 是 把 程序 对 象 化 ， 上 面 的 我 们 已 经 做 了 ; 第 二 步 再 把 公用 的 属性 和 方法 提取 
封装 ， 可 以 统一 把 公用 的 部 分 提取 到 一 个 Game 的 父 类 里 面 ， 让 Snake 类 继承 Game 类 ， 从 而 实现 游戏 框架 定义 。 我 们 画 出 Game 类 和 Snake 类 的 类 图 ， 所 图 6-12 所 示 。 


*initialize() 
*init () 
*failO 


eorr c —À *fruit() 
*initialize() Head Ó 


*init () N tbody 0 
*stage0 () *drawTable () 
*stage2() *drawMatrix() 
stagel() *stagel () 
+index () +stage0 () 
+fail() | 'stage2 () 
*keydown Q 'kevdown () 
*run () | 


642 4&3 


;Game 类 公共 属性 ， 包 括 了 所 有 的 Snake 类 的 属性 ， 这 是 因为 这 些 属性 都 是 全 局 的 ， 其 他 的 游戏 也 会 用 到 ， 而 且 每 个 游戏 中 的 属性 ， 可 以 在 变量 e 中 进行 扩展 。 
;Game 类 公共 方法 ， 包 括 了 游戏 全 局 调用 的 方法 ， 但 不 包括 Snake 游 戏 stage1 场 景 中 运行 的 方法 。 在 Game 类 的 方法 中 ， 我 们 主要 实现 的 都 是 开发 的 辅助 功能 。 
Snake 类 方法 ， 有 一 些 是 从 Game 类 继承 的 方法 ， 这 是 用 到 方法 的 重 写 技术 。 子 类 的 方法 ， 先 调用 父 类 的 同名 方法 ， 然 后 再 执行 子 类 方法 里 的 程序 。 

这 样 我 们 就 简单 地 分 离 了 游戏 框架 Game 类 和 游戏 实现 Snake 类 ， 下 面 我 们 要 做 的 就 是 把 代码 按照 设计 进行 实现 ， 看 看 我 们 的 设计 是 否 合理 。 

6.3.3 ”在 框架 中 重新 实现 贪 食 蛇 游戏 


本 节 的 系统 环境 是 : 


* Windows 7 64bit 


- R: 3.1.1 x86. 64-w64-mingw32/x64. (64-bit) 


Game 类 的 代码 实现 ， 


R 语 言 基于 RC 面向 对 象 编程 进行 代码 编写 ， 


新 建 game.r 文 件 代码 如 下 。 


Game<-setRefClass ('Game', 
fields-list ( 


# 名 字 
# 调试 状态 
EEEE 
HEES 


# 场景 

# 环境 空间 变量 
# 数据 矩阵 

# 游戏 失败 


name-"character", 
debug-'logical', 
width-'numeric', 
height-'numeric', 
# 应 用 变量 
stage-'numeric', 
e-'environment', 
m-'matrix', 
isFail-'logical' 
Ja 
methods-list ( 
* 构造 函数 
initialize = function (name, width, height, debug) ( 
name««-"R Game Framework" 
debug««-FALSE 
width««-height««-20 HEERS 
h 
# 初始 化 变量 
init = function () ( 
e««-new.env () # 环 境 空间 
m««-matrix (rep (0, width*height) , nrow-width) 
isFail««-FALSE 


HAHET 


]， 
+ 开机 画图 
stage0=function () { 
stage««-0 
init () 
h 
+ 结束 画图 
stage2-function () { 
stage««-2 
h 
# 游戏 中 
stagel-function (default-FALSE) ( 
stage««-1 
if (FALSE) ( # 默认 游戏 中 界面 
plot (0, 0, xlim-c (0, 1) , ylimec (0, 1) , type='n', 
text (0.5, 0.7, label-"Playing", cex-5) 
} 


fs 

# HOA 

index = function (col) { 
return (which (m--col) ) 


Fé 
# 失败 操作 
fail=function (msg) { 


xaxs="i", yaxs="i") 


print (paste ("Game Over", msg) ) 
isFail<<-TRUE 
keydown ('q') 
return (NULL) 
# 键盘 事件 ， 控 制 场景 切换 
keydown-function (K) ( 
if (stage--0) | 并 开 机 画面 
stagel () 
return (NULL) 
HERAN 
q0) 
else if (K--' ') stage0 () 


return (NULL) 
} 
h 
* 启动 程序 
run-function () ( 
par (mai-rep (0, 4) , oma-rep (0, 4) ) 
stage0 () 
getGraphicsEvent (prompt-"Snake Game", onKeybd-function (K) ( 
if (debug) print (paste ("keydown", K) ) 
return (keydown (K) ) 
p 
} 
F? 


Snake 类 的 代码 实现 ， 继 承 Game 类 ， 并 实现 贪 食 蛇 游 戏 的 私有 方法 ， 新 建 snake.r 文 件 代码 如 下 所 示 。 


4 引用 game.r 文 件 

source (file="game.r") 

# Snake 类 ， 继 承 Game 类 

Snake<-setRefClass ("Snake", contains="Game", 
methods-list ( 


+ 构造 函数 

initialize = function (name, width, height, debug) { 
callSuper (name, width, height, debug) # 调 父 类 
name<<-"Snake Game" 

h 

+ 初始 化 变量 

init = function () ( 
callSuper () # 调 父 类 
e$step««-1/width # 步 长 
e$dir««-e$lastd««-'up' # 移动 方向 
eShead««-c (2, 2) # 初始 蛇 头 坐标 


e$lastx««-e$lasty««-2 
e$tail««-data.frame (x-c () , y=c O ) 


# 蛇 头 上 一 个 点 坐标 
# 初始 蛇 尾 坐标 


e$col fruit««-2 + KRAE 
e$col head««-4 * 蛇 头 颜色 
e$col tail««-8 + 蛇 尾 颜色 
e$col path««-0 * 路 颜色 
e$col barrier««-1 t 障碍 颜色 


h 

t 失败 检查 

lose=function () { 
# head 出 边界 


if (length (which (e$head<1) ) >0 | length (which (e$head>width) ) >0) { 


fail ("Out of ledge.") 
return (NULL) 


} 

# headsís|tail 

if (m[e$head[1], e$head[2]]==e$col_tail) { 
fail ("head hit tail.") 
return (NULL) 

} 


h 

E 随机 的 水 果 点 

fruit-function () ( 

if (length (index (e$col fruit) ) «-0) ( 
idx«-sample (index (e$col path) , 1) 
fx«-ifelse (idx$$width--0, 10, idx$$width) 
fy«-ceiling (idx/height) 
m[fx, fy]««-e$col fruit 
if (debug) ( 
print (paste ("fruit idx", idx) ) 


# 不 存在 水 果 


print (paste ("fruit axis: ", fx, fy) ) 
} 
} 


) 

# snake head 

head-function () ( 
eSlastx««-e$head[1] 
eSlasty««-eShead[2] 
# 方向 操作 


up') eS$head[2]<<-e$head[2] 
down') e$head[2]««-e$head[ 
left') e$head[1]««-e$head[ 
right') eShead[1]««-e$head[ 


+1 
2] 
1] 
E 


-1l 
=l 
]41 
h, 
# snake body 
body=function () { 

if (isFail) return (NULL) 

m[e$lastx, e$lasty]<<-e$col_path 

m[e$head[1], e$head[2]]<<-e$col_head #snake 

if (length (index (e$col fruit) ) <=0) { # 不 存在 水 果 

e$tail««-rbind (e$tail, data.frame (x-e$lastx, y-e$lasty) ) 


) 

if (nrow (e$tail) 50) ( # 如 果 有 尾巴 
e$tail««-rbind (e$tail, data.frame (x-e$lastx, y-e$lasty) ) 
m[e$tail[1, ]$x, e$tail[1, ]$y]««-e$col path 
e$tail««-e$tail[-1, ] 
m[e$1astx, e$lasty]««-e$col tail 


) 
if (debug) ( 
print (paste ("snake idx", index (e$col head) ) ) 
print (paste ("snake axis: ", e$head[1], e$head[2]) ) 
) 


) 
Pow^ux 
drawTable-function () ( 

if (isFail) return (NULL) 


plot (0, 0, xlimec (0, 1) , ylimec (0, 1) , type-'n', xaxs= , yaxs-" 
if (debug) ( 
# 显示 背景 表格 
abline (h-seq (0, 1, e$step) , col-"gray60") E KPR 
abline (v=seq (0, 1, e$step) , col="gray60") ERA 
# 显示 矩阵 


df«-data.frame (x-rep (seq (0, 0.95, e$step) , width) , y-rep (seq (0, 0.95, e$step) , 
each-height) , lab-seq (1, width*height) ) 
text (df$xte$step/2, df$yte$step/2, label-df$lab) 
) 


) 
d 根据 矩阵 画 数据 
drawMatrix-function () ( 
if (isFail) return (NULL) 
idx«-which (m»0) 
px«- (ifelse (idx$$width--0, width, idx$$width) -1) /widthte$step/2 
py<- (ceiling (idx/height) -1) /height*e$step/2 
pxy«-data.frame (x-px, y-py, colem[idx]) 
points (pxy$x, pxy$y, col-pxy$col, pch-15, cex-4.4) 


h 
# 游戏 场景 
stagel=function () { 
callSuper () 
fruit () 
head () 
lose () 
body () 
drawTable () 
drawMatrix () 
h 
# 开机 画图 
stage0=function () { 
callSuper () 
plot (0, 0, xlimec (0, 1) , ylim=c (0, 1) , type-'n', xaxs= 


, yaxs-" 


text (0.5, 0.7, label-name, cex-5) 

text (0.5, 0.4, label-"Any keyboard to start", cex-2, col-4) 

text (0.5, 0.3, label-"Up, Down, Left, Rigth to control direction", cex-2, col-2) 
text (0.2, 0.05, label-"Author: DanZhang", cex-1) 

text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


h 
# 结束 画图 
stage2-function () ( 
callSuper () 
info«-paste ("Congratulations! You have eat", nrow (e$tail) , "fruits! ") 
print (info) 
plot (0, 0, xlim-c (0, 1) , ylimec (0, 1) , type-'n', xaxs-"i", yaxs-"i") 
text (0.5, 0.7, label-"Game Over", cex-5) 
text (0.5, 0.4, label-"Space to restart, q to quit.", cex-2, col-4) 
text (0.5, 0.3, label-info, cex-2, col-2) 
text (0.2, 0.05, label-"Author: DanZhang", cex-1) 
text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


h, 

# 键盘 事件 ， 控 制 场景 切换 

keydown-function (K) ( 
callSuper (K) 


if (stage--1) ( # 游 戏 中 
if (K = "q") stage2 () 
else { 


if (tolower (K) $in$ c ("up", "down", "left", "right") ) ( 
e$lastd««-e$dir 
e$dir««-tolower (K) 
stagel () 


) 
return (NULL) 
} 
return (NULL) 
} 
)) 
snake«-function () ( 
game«-Snake$new () 
gameSinitFields (debug-TRUE) 
game$run () 
l 


snake () 


最 后 ， 我 们 运行 snake.r 的 程序 ， 就 完成 了 整个 贪 食 蛇 游戏 。 游 戏 运行 效果 ， 可 以 查看 6.2 节 的 游戏 截 


， 即 图 6-8。 


D 


我 们 已 经 完成 了 贪 食 蛇 游戏 的 开发 ， 虽 然 界面 还 是 比较 士 ， 而 且 没有 时 间 维度 的 操作 。 那 么 我 们 换 一 个 角度 思考 ， 如 果 不 太 要 求 画面 效果 ， 而 且 不 需要 时 间 维 度 的 游戏 ， 是 不 是 
当然 ， 这 类 游戏 也 有 很 多 ， 比 如 最 近 流 行 的 2048。 那 么 接 下 来 ， 就 用 我 们 的 游戏 框架 ， 再 来 做 一 个 2048 的 游戏 吧 ， 试 试 在 100 行 之 内 实现 这 个 游戏 。 


6.4 R 语 言 制作 游戏 2048 


问题 


如 何 用 语言 实现 2048 游 戏 ? 


R 语 言 会 


表现 得 更 好 呢 ? 


游戏 2048 


虽然 R 语 言 并 不 适合 做 游戏 开发 ， 但 是 R 语 言 中 的 向 量 计算 ， 能 极 大 地 简化 给 阵 算 法 代码 实现 的 复杂 度 ， 可 以 高 效 地 完成 计算 任务 。 如 果 我 们 


150 行 代码 写 出 游戏 2048， 哪 种 语言 能 实现 ? 答案 是 R 语 言 。 
把 游戏 问题 变 成 数学 问题 ， 那 么 R 就 是 绝 佳 的 工具 。 


6.4.1 2048 游 戏 介绍 

2048 是 一 款 单 人 在 线 和 移动 端 游 戏 ， 由 19 岁 的 意大利 人 Gabriele Cirulli 于 2014 年 3 月 开发 。 游 戏 任务 是 在 一 个 网 格 上 滑动 小 方块 来 进行 组 合 ， 直 到 形成 一 个 带 有 数字 2048 的 方块 ， 它 是 滑 块 类 游戏 的 一 
种 电脑 变 体 。 作 者 开发 这 个 游戏 是 为 了 测试 自己 是 否 有 能 力 从 零 开始 创造 一 款 游戏 ， 但 游戏 靓 升 的 人 气 (不 到 1 周 内 有 400 万 访客 ) 完全 出 乎 他 的 预料 。 事 实 上 ， 它 已 被 称 为 网 络 上 “最 上 痛 的 东西 ”， 华 尔 
街 日 报 将 其 评价 为 “属于 数学 极 客 的 Candy Crush”， 游 戏 截图 如 图 6-13 所 示 。 


2048 


iin the numbers ^d Qo! to Ihe 2048 tile! 


图 6-13 2048 游戏 截图 


该 游戏 为 开源 软件 ， 这 导致 它 衍生 出 许多 改进 版 和 变种 ， 包 括 积分 排行 榜 、 提 升 的 触 屏 可 玩 性 等 。2048 是 基于 HTML5 的 JavaScript 应 用 ， 源 代码 的 地 址 为 https://github.com/gabrielecirulli/2048， 
免费 的 在 线 版 本 地 址 为 http://gabrielecirulli.github.io/2048/。 本 文中 R 语 言 的 程序 实现 ， 完 全 是 笔者 的 个 人 想法 ， 与 游戏 作者 的 JS 源 代码 无 关 。 


该 游戏 使 用 方向 键 让 方块 上 下 左右 移动 。 如 果 两 个 带 有 相同 数字 的 方块 在 移动 中 碰撞 ， 则 它们 会 合并 为 一 个 数字 ， 为 两 者 之 和 。 每 次 移动 时 ， 会 有 一 个 值 为 2 或 者 4 的 新 方块 出 现 。 当 值 为 2048 的 方块 出 
现时 ， 游 戏 即 胜利 ， 该 游戏 因此 得 名 。 
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接 下 来 ， 就 回 到 游戏 设计 环节 ， 同 6.2 节 中 贪 食 蛇 入 门 一 样 。 要 开发 2048 这 款 游戏 ， 我 们 应 该 如 何 动手 呢 ? 我 们 需要 从 软件 开发 的 角度 ， 对 这 款 游戏 进行 需求 分 析 ， 列 出 游戏 的 规则 ， 并 设计 业务 流程 ， 
给 出 游戏 的 原型 ， 验 证 是 否 可 行 。 


1. 需 求 分 析 

2048 游 戏 ， 应 该 有 3 个 场景 ， 即 开机 场景 、 游 戏 场景 和 结束 场景 。 

“ 开机 场景 : 启动 程序 ， 在 游戏 开始 前 ， 给 用 户 做 准备 ， 并 提示 如 何 操作 游戏 。 

“ 游戏 场景 : 游戏 运行 中 的 场景 。 

“ 结束 场景 : 当 用 户 胜利 、 失 败 或 退出 时 的 场景 ， 并 提示 用 户 在 游戏 中 的 得 分 。 

开机 场景 和 结束 场景 比较 简单 ， 不 再 解释 。 游 戏 场景 ， 包 括 一 块 4*4 的 画布 ， 画 面 中 每 个 格子 对 应 一 个 数字 ， 数 字 大 于 0 的 格子 有 背景 颜色 填充 。 
2. 游 戏 规则 

游戏 进行 时 的 规则 : 

(1) 开始 游戏 后 ， 用 户 可 以 通过 上 (up). F (down) 、 左 (left) 、 右 (right) 键 ， 来 控制 画布 中 数字 的 移动 。 
(2) 如 果 两 个 相同 的 数字 在 移动 中 碰撞 ， 则 它们 会 合并 为 一 个 ， 且 数字 变 为 两 者 之 和 。 

(3) 每 次 移动 时 ， 会 有 一 个 值 为 2 或 者 4 的 新 数字 在 空白 格子 上 出 现 。 

(4) 当 用 户 按键 操作 ， 数 字 的 顺序 未 发 生变 化 时 ， 则 不 会 生成 新 数字 ， 视 为 无 效 的 按键 操作 。 

(5) 当 画 布 格子 被 数字 填 满 时 ， 但 在 上 下 左右 方向 都 没 可 合并 的 数字 时 ， 则 游戏 失败 。 

3. 业 务 流程 


把 游戏 设 定 为 3 个 场景 ， 那 么 游戏 场景 的 切换 流程 ， 如 图 6-14 所 示 ， 具 体 说 明 如 下 。 


EY dup È h 


程序 退出 


图 6-14 2048 游 戏 业 务 流程 定义 
“ 打开 程序 时 ， 用 户 首先 看 到 开机 场景 ， 按 任意 键 后 进入 游戏 场景 。 
“ 在 游戏 场景 ， 当 游戏 失败 ， 进 入 结束 场景 ; 按 q 键 ， 则 直接 游戏 失败 。 
“ 在 结束 场景 ， 按 空格 回 到 开机 场景 ; 按 q 键 ， 则 直接 能 退出 程序 。 
从 图 6-14 看 出 ，2048 游 戏 的 业务 流程 ， 同 贪 食 蛇 游戏 的 业务 流程 。 


4 游戏 原型 


我 们 画 出 3 个 场景 的 界面 。 左 边 为 开机 场景 ， 中 间 是 游戏 场景 ， 右 边 是 结束 场景 ， 如 图 6-15 所 示 。 


2048 Game Game Over 


Any keyboard to start Space to restart, q to quit. 


Up,Down,Left,Rigth to control direction Congratulations! You have max number 128 ! 


EH6-15 2048234 53x 


根据 游戏 原型 的 图 ， 用 程序 画 出 游戏 的 场景 。 
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通过 上 面 的 功能 需求 分 析 ， 我 们 已 经 非常 清楚 地 了 解 2048 游 戏 的 各 种 规则 和 功能 。 接 下 来 ， 我 们 要 把 需求 分 析 中 的 业务 语言 ， 通 过 技术 语言 重新 描述 ， 并 考虑 非 功 能 需求 ， 以 及 R 语 言 相关 的 技术 细 


T. 
1 .游戏 场景 
我 们 让 每 个 场景 对 应 一 块 画布 ， 即 每 个 场景 对 应 一 个 内 存 结构 。 
“ 开机 场景 ， 是 静态 的 ， 我 们 可 以 提前 生成 好 这 块 画 布 存 储 起 来 ， 也 可 以 当 用 户 切换 时 再 临时 生成 ， 性 能 开销 不 大 。 
“ 游戏 场景 ， 是 动态 的 ， 每 进行 一 次 用 户 的 交互 行为 或 按时 间 刷 新 时 ， 都 需要 重新 绘制 画布 ， 让 游戏 场景 通过 绑 定 事件 来 生成 画布 。 
: 结束 场景 ， 是 动态 的 ， 在 结束 场景 会 显示 当 次 游戏 的 得 分 ， 需 要 在 切换 时 临时 生成 。 
2. 游 戏 对 象 


在 游戏 进行 中 ， 会 产生 很 多 的 对 象 ， 如 上 文中 提 到 的 。 这 些 对 象 都 需要 在 内 存 中 进行 定义 ， 然 后 匹配 到 对 应 程序 语言 的 数据 类 型 。 


比 起 贪 食 蛇 游戏 ，2048 游 戏 要 简单 很 多 ， 我 只 需要 定义 一 个 画布 对 象 就 行 了 。 
ARAR: HARDER AREE. 

: 画布 中 的 数字 : 用 给 阵 中 的 数字 值 来 表示 。 

:画布 的 背景 色 : 用 矩阵 中 的 数字 值 来 表示 。 


通过 矩阵 来 描述 游戏 画布 和 对 象 ， 矩 阵 结构 如 下 所 示 : 


DL 11 D, 21 [, 3]. [, 41 
[1, ] 4 32 4 3 
[2,] 32 16 2 4 


图 6-16 ”2048 游 戏 画布 


3 .游戏 事件 
游戏 过 程 中 ， 会 有 2 种 事件 ， 键 盘 事件 和 碰撞 事件 。 
“ 键盘 事件 : 是 全 局 事件 ， 用 户 通过 键盘 输入 而 触发 的 事件 ， 比 如 ， 上 下 左右 键 的 操作 ， 用 来 控制 数字 合并 的 方向 。 


:碰撞 事件 : 如 果 两 个 相同 的 数字 在 移动 中 发 生 碰撞 ， 则 它们 会 合并 为 一 个 数字 。 


游戏 过 程 中 ， 全 局 监听 键盘 事件 ， 用 键盘 事件 触发 碰撞 事件 ， 检 查 游戏 状态 。 
4. 游 戏 控制 | 


在 游戏 进行 中 ， 每 个 状态 都 需要 进行 控制 。 比 如 ， 什 么 时 候 生成 新 的 数字 ， 什 么 时 候 合并 相同 的 数字 ， 什 么 时 候 游戏 结束 等 。 通 过 定义 控制 函数 ， 可 以 方便 我 们 管理 游戏 运行 中 的 各 种 游戏 状态 ， 如 图 
6-17 所 示 。 


加 载 程序 


uus 


图 6-17 2048 游 戏 程序 流程 


图 6-17 中 每 个 方块 代表 一 个 R 语 言 函 数 定义 。 


onn () : 启动 程序 。 
.keydown () : 监听 键盘 事件 ， 锁 定 线程 。 
- stage0 () : 创建 开机 场景 ， 可 视 化 输出 。 


“ stagel () : 创建 游戏 场景 ， 可 视 化 输出 。 


- stage2 () : 创建 结束 场景 ， 可 视 化 输出 。 


“init() : 打开 游戏 场景 时 ， 初 始 化 游戏 变量 。 


-create () : 判断 并 生成 数字 。 

(move () : 移动 数字 。 

"lose () : 失败 查询 ， 判 断 当 画 布 格子 是 否 被 数字 填 满 且 不 能 合并 数字 时 ， 进 行 结束 场景 。 
“ drawTable () : 绘制 游戏 背景 。 

< drawMatrix () : 绘制 游戏 矩阵 。 


通过 程序 设计 过 程 ， 我 们 就 把 需求 分 析 中 的 业务 语言 描述 ， 变 成 了 程序 开发 中 的 技术 语言 描述 。 经 过 完整 的 设计 后 ， 最 后 就 剩 下 写 代码 了 。 
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按照 上 面 的 函数 定义 ， 我 们 就 可 以 把 代码 像 填空 一 样 地 写 进去 了 。 由 于 我 们 之 前 已 经 做 好 了 一 个 游戏 框架 ， 场 景 函数 及 功能 函数 定义 已 在 框架 中 实现 了 一 部 分 ， 剩 下 只 填 入 游戏 逻辑 的 代码 就 行 了 。 关 
于 R 语 言 游戏 框架 介绍 ， 请 参考 6.3 节 。 

本 节 的 系统 环境 是 : 

* Windows 7 64bit 


- R: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 


1 数字 移动 函数 move () 


13. 


2048253x 837 LE ESARBUERE, MERFI. EAE, icem E TMACRUWTISIUEEAD, A AEREA. ARAE AARNA ORA, SODBUEERSSURUE 
数字 合并 的 正确 性 。 


我 们 先 把 这 个 函数 从 框架 中 抽出 来 ， 单 独 进行 实现 和 单元 测试 。 构 建 函数 moveFun () , iX8 


简化 移动 过 程 ， 只 考虑 左右 移动 ， 后 面 再 通过 翻转 的 计算 ， 让 上 下 移动 和 左右 移动 的 核心 算法 共用 一 套 代 


if (dir 
return (x1) 


right') xl«-rev (xl) 


> moveFun«-function (x, dir) { # 移动 函数 

+ if (dir == 'right') x<-rev (x) # 如 果 向 右 移 动 ， 则 倒叙 排列 
+ 

* lenO0«-length (which (x--0) ) # 0 长 度 

+  xl«-x[which (x>0) ] # 去 掉 0 

+  posl«-which (diff (x1) —0) E Rd qu DUCES 
十 

+ if (length (posl) —3) ( # 3 个 索引 

十 pos1<-pos1[c (1, 3) ] 

+  Jelse if (length (posl) ==2 && diff (posl) —1) ( # 2 个 索引 
十 posi«-posl[1] 

十 

十 

+  xl[posl]«-xl[pos1]*2 

+  xl[posl4l]e-0 

H 

+  xi«-xl[which (x1>0) ] # 去 掉 0 

+  xi«-c (xl, rep (0, 4) ) [1: 4] * 补 0， 取 4 个 

n 

十 

+ 

十 


接 下 来 ， 为 了 检验 函数 moveFun () 的 正确 性 ， 我 们 使 用 单元 测试 工 


包 testthat 来 检验 算法 是 否 正确 。 关 于 testthat 包 的 介绍 ， 


请 参考 5.2 节 。 


按 游戏 规则 我 们 模拟 数字 左右 移动 ， 验 证 计算 结果 是 否 与 我 们 给 出 的 目标 值 相同 ， 如 图 


6-18 所 示 。R 语 言 单元 测试 的 代码 如 下 。 


> library (testthat) 

*x«-c(4,2,2, 2) 

> expect that (moveFun (x, 'left') , equals (c (4, 4, 2, 0) ) ) 
> expect that (moveFun (x, 'right') , equals (c (0, 4, 2, 4) ) ) 
> x«-c (J, 4, 2, 4) 

» expect that (moveFun (x, 'left') , equals (c (8, 2, 4, 0) ) ) 
> expect that (moveFun (x, 'right') , equals (c (0, 8, 2, 4) ) ) 
» x«-c (2, 2, 0, 2) 

» expect that (moveFun (x, 'left') , equals (c (4, 2, 0, 0) ) ) 
> expect that (moveFun (x, 'right') , equals (c (0, 0, 2, 4) ) ) 
» x«-c (2, 4, 2, 4) 

» expect that (moveFun (x, 'left') , equals (c (2, 4, 2, 4) ) ) 
> expect that (moveFun (x, 'right') , equals (c (2, 4, 2, 4) ) ) 
> x«-c (J, 4, 2, 2) 

» expect that (moveFun (x, 'left') , equals (c (8, 4, 0, 0) ) ) 
» expect that (moveFun (x, 'right') , equals (c (0, 0, 8, 4) ) ) 
» x«-c (2, 2, 4, 4) 

> expect that (moveFun (x, 'left') , equals (c (4, 8, 0, 0) ) ) 
» expect that (moveFun (x, 'right') , equals (c (0, 0, 4, 8) ) ) 
» x«-c (4, 4, 0, 4) 

» expect that (moveFun (x, 'left') , equals (c (8, 4, 0, 0) ) ) 
» expect that (moveFun (x, 'right') , equals (c (0, 0, 4, 8) ) ) 
> x«-c (J, 0, 4, 4) 

» expect that (moveFun (x, 'left') , equals (c (8, 4, 0, 0) ) ) 
» expect that (moveFun (x, 'right') , equals (c (0, 0, 4, 8) ) ) 
» x«-c (4, 0, 4, 2) 

> expect that (moveFun (x, 'left') , equals (c (8, 2, 0, 0) ) ) 
> expect that (moveFun (x, 'right') , equals (c (0, 0, 8, 22 ) ) 
> x«-c (2, 2, 2, 2) 

» expect that (moveFun (x, 'left') , equals (c (4, 4, 0, 0) ) ) 
» expect that (moveFun (x, 'right') , equals (c (0, 0, 4, 4) ) ) 
» x«-c (2, 2, 2, 0) 

» expect that (moveFun (x, 'left') , equals (c (4, 2, 0, 0) ) ) 
> expect that (moveFun (x, 'right') , equals (c (0, 0, 2, 4) ) ) 


pee] 8t 
Fern [em] on 
pja jea 
erem Eon 
Reo [ee] on 
EET 
ERE 
erem] on 


图 6-18 ”2048 游 戏 算法 测试 


当然 我 们 还 可 以 写 更 多 的 测试 用 例 来 检验 函数 计算 的 正确 性 。 单 元 测试 全 部 正确 ， 这 样 就 实现 了 数字 移动 的 核心 算法 了 。 
2. 其 他 函数 实现 
接 下 来 ， 我 们 还 要 完成 其 他 的 函数 实现 ， 代 码 结构 同 贪 食 蛇 游戏 。 


开机 场景 函数 stage0 () 。 


stage0=function () { domu 


callSuper () 

plot (0, 0, xlim=c (0, 1) , ylimec (0, 1) , type-'n', xaxs- 
text (0.5, 0.7, label-name, cex-5) 

text (0.5, 0.4, label-"Any keyboard to start", cex-2, col-4) 

text (0.5, 0.3, label-"Up, Down, Left, Rigth to control direction", cex-2, col-2) 
text (0.2, 0.05, label-"Author: DanZhang", cex-1) 

text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


yaxs-"i") 


结束 场景 函数 stage2 () 。 


stage2-function () ( # 结束 画图 
callSuper () 
info«-paste ("Congratulations! You have max number", max (m) , "! ") 


print (info) 

plot (0, 0, xlimec (0, 1) , ylimec (0, 1) , type-'n', xaxs-"i" 
text (0.5, 0.7, label-"Game Over", cex-5) 

text (0.5, 0.4, label-"Space to restart, q to quit.", cex-2, col-4) 
text (0.5, o, cex-2, col-2) 

text (0.2, uthor: DanZhang", cex-1) 

text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


yaxs-"i") 


键盘 事件 ， 控 制 场景 切换 。 


keydown-function (K) ( # 键盘 事件 ， 控 制 场景 切换 
callSuper (K) 
if (stage--1) ( # 游 戏 中 
if (K == "q") stage2 () 
else ( 


if (tolower (K) inb c ("up", "down", "left", "right") ) ( 
e$dir««-tolower (K) 
print (e$dir) 
stagel () 
) 
) 
return (NULL) 


H 
return (NULL) 


游戏 场景 初始 化 函数 init () 。 


init = function () ( # 初始 化 变量 
callSuper () # 调 父 类 
e$max««-4 # 最 大 数字 
e$step««-1/width LEES 
e$dir««-'up' 
e$colors««-rainbow (14) dn 6 
e$stop««-FALSE LES PR LE NIE 
create () 

) 

随机 产生 一 个 新 数字 函数 create () 。 

create=function () { d 随机 产生 一 个 新 数字 


if (length (index (0) ) >0 & ! e$stop) { 
e$stop««-TRUE 
one«-sample (c (2, 4) , 1) 
idx«-ifelse (length (index (0) ) —1, index (0) , sample (index (0) , 1) ) 
m[idx]««-one 


失败 条 件 函数 lose () 。 


lose-function () { # 失 败 条 件 
near<-function (x) { * 判断 是 否 有 相 邻 的 有 重复 值 
length (which (diff (x) ==0) ) 
} 


if (length (index (0) ) —0) { # 判断 无 空格 子 
h«-apply (m, 1, near) # 水 平方 向 
v«-apply (m, 2, near) # 垂直 方向 


if (length (which (h>0) ) ==0 & length (which (v>0) ) —0) { 
fail ("No free grid.") 
return (NULL) 
} 
} 


游戏 画布 函数 drawTable () 。 


drawTable-function () { # 画布 背景 
if (isFail) return (NULL) 
plot (0, 0, xlim-c (0, 1) , ylimec (0, 1) , type-'n', xaxs-"i", yaxs-"i") 


abline (h-seq (0, 1, e$step) , ci gray60") # 水 平 线 
abline (v-seq (0, 1, e$step) , col-"gray60") # 垂直 线 
} 
游戏 矩阵 函数 drawMatrix () 。 
drawMatrix-function () { d 根据 和 矩阵 天 数据 
if (isFail) return (NULL) 
a<-c (t (m) ) 


lab«-c (a[13: 16], a[9: 12], a[5: 8], a[l: 41) 

d«-data.frame (x-rep (seq (0, 0.95, e$step) , width) , y-rep (seq (0, 0.95, e$step) , each-height) , 
lab-lab) 

df«-d[which (d$1ab»0) , ] 

points (df$x*e$step/2, df$y*e$step/2, col-e$colors[log (df$lab, 2) ], pch-15, cex-23) 

text (df$xte$step/2, df$yse$step/2, label-df$lab, cex-2) 


游戏 场景 函数 stage1 () . 


stagel-function () ( # 游戏 场景 
callSuper () 
move 0 
lose () 
create () 
drawTable () 
drawMatrix () 


最 后 ， 完 整 的 程序 代码 保存 在 2048.r 文 件 中 ， 如 下 所 示 。 


source (file-"game.r") # 加 载 游戏 框架 
# _ Snake 类， 继承 Game 类 
G2048«-setRefClass ("G2048", contains-"Game", 
methods-list ( 
# 构造 函数 
initialize = function (name, debug) { 
callSuper (name, debug) # 调 父 类 
name««-"2048 Game" 
width««-height««-4 


h 
# 初始 化 变量 
init = function () { 


callSuper () # 调 父 类 
e$max««-4 # 最 大 数字 
e$step<<-1/width # 步 长 
e$dir««-'up' 

e$colors««-rainbow (14) # 颜色 
e$stop««-FALSE E 不 满足 移动 条 件 
create () 


fi 
# 随机 产生 一 个 新 数字 
create-function () ( 
if (length (index (0) ) >0 & ! e$stop) { 
e$stop««-TRUE 
one«-sample (c (2, 4) , 1) 
idx«-ifelse (length (index (0) ) ==1, index (0) , sample (index (0) , 1) ) 
m[idx]««-one 
) 


h, 
# 失 败 条 件 
lose-function () ( 
+ 判断 是 否 有 相 邻 的 有 重复 值 
near«-function (x) { 
length (which (diff (x) 一 0) ) 
} 


+ 无 空格 子 

if (length (index (0) ) ==0) ( 
h«-apply (m, 1, near) # 水 平方 向 
v<-apply (m, 2, near) # 垂直 方向 


if (length (which (h>0) ) ==0 & length (which (v>0) ) —0) { 
fail ("No free grid.") 
return (NULL) 
} 
} 
h 
# 方向 移动 
move-function () ( 
# 方向 移动 函数 


moveFun-function (x) { 


if (e$dir $in$ c ('right', 'down') ) x«-rev (x) 
len0<-length (which (x==0) ) # 0 长 度 
x1<-x[which (x>0) ] # 去 掉 0 
posl<-which (diff (x1) ==0) ous de DUC VR 
if (length (pos1) —3) ( + 3 个 索引 
posi«-posl[c (1, 3) ] 
Jelse if (length (posl) 一 2 && diff (posl) 一 1) ( # 2 个 索引 


posl«-posl[1] 


xl[posl]«-x1l[pos1]*2 
xl[posl41]«-0 
xl«-xl[which (x1>0) ] # 去 掉 0 
xi<-c (xl, rep (0, 4) ) [1: 4] # 补 0， 取 4 个 
if (e$dir $in$ c ('right', 'down') ) xl<-rev (xl) 
return (x1) 
} 


m<<-t (apply (m, 1, moveFun) ) 

m<<-t (apply (m, 1, moveFun) ) 

m<<-apply (m, 2, moveFun) 

m<<-apply (m, 2, moveFun) 

e$stop««-ifelse (length (which (m ! = last m) ) ==0, TRUE, FALSE) 


*og*quE 
drawTable-function () { 
if (isFail) return (NULL) 
plot (0, 0, xlimec (0, 1) , ylimec (0, 1) , type-'n', 
abline (heseq (0, 1, e$step) , col-"gray60") 
abline (v-seq (0, 1, e$step) , col-"gray60") 


h, 
d 根据 矩阵 画 数 据 
drawMatrix=function () { 
if (isFail) return (NULL) 
a<-c (t (m) ) 
lab«-c (a[13: 16], a[9: 12], a[5: 8], a[l: 41) 
d«-data.frame (x-rep (seq (0, 0.95, e$step) , width) , y=rep (seq (0, 0.95, e$step) , each- 
height) , lab-lab) 
df«-d[which (d$1ab»0) , ] 
points (df$xte$step/2, df$yte$step/2, col-e$colors[log (df$lab, 2) ], pch-15, cex-23) 
text (df$xte$step/2, df$yte$step/2, label-df$lab, cex-2) 


h, 
+ 游戏 场景 
stagel=function () { 
callSuper () 
move () 
lose () 
create () 
drawTable () 
drawMatrix () 


h, 
* 开机 画图 
stage0=function () ( 
callSuper () 
plot (0, 0, xlimec (0, 1) , ylimec (0, 1) , type-'n', xaxs-"i", yaxs-"i") 
text (0.5, 0.7, label-name, cex-5) 
text (0.5, 0.4, label-"Any keyboard to start", cex-2, col-4) 
text (0.5, 0.3, label-"Up, Down, Left, Rigth to control direction", cex-2, col-2) 
text (0.2, 0.05, label-"Author: DanZhang", cex-1) 
text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


h 
# 结束 画图 
stage2=function () { 
callSuper () 
info«-paste ("Congratulations! You have max number", max (m) , "! ") 
print (info) 
plot (0, 0, xlim-c (0, 1) , ylimec (0, 1) , type-'n', xaxs-"i", yaxs-"i") 
text (0.5, 0.7, label-"Game Over", cex-5) 
text (0.5, 0.4, label-"Space to restart, q to quit.", cex-2, col-4) 
text (0.5, 0.3, label-info, cex-2, col-2) 
text (0.2, 0.05, label-"Author: DanZhang", cex-1) 
text (0.5, 0.05, label-"http: //blog.fens.me", cex-1) 


h, 
# 键盘 事件 ， 控 制 场景 切换 
keydown-function (K) ( 
callSuper (K) 
if (stage--1) ( # 游戏 中 
if (K == "q") stage2 () 
else ( 
if (tolower (K) $in$ c ("up", "down", "left", "right") ) ( 
eSdir««-tolower (K) 
stagel () 
} 


} 
return (NULL) 


return (NULL) 


# 封装 启动 函数 

g2048<-function () { 
game«-G2048$new () 
game$initFields (debug-TRUE) 
game$run () 


} 
# 启动 游戏 
g2048 () 


游戏 截图 ， 所 6-19 所 示 。 


2048 Game 


Any keyboard to start 


Up,Down,Left,Rigth to control direction 


Author.DanZhang htlp.//blog.fens.me 


图 6-19 ”2048 游 戏 动画 


全 部 代码 仅仅 190 行 ， 有 效 代码 行 只 有 150 行 左右 ， 我 们 就 实现 了 2048 游 戏 。 用 R 语 言 处 理 和 矩阵 的 向 量 计 算 ， 还 是 很 方便 的 。 另 外 我 们 又 用 面向 对 象 的 方法 ， 对 游戏 程序 进行 了 统一 的 封装 ， 标 准 化 了 函 


数 定义 和 接口 ， 


让 我 们 能 更 专注 于 游戏 算法 本 身 ， 提 高 开发 的 效率 。 再 下 一 步 ， 就 可 以 把 游戏 这 个 框架 项 目 打 包 发 布 到 R 的 官方 库 CRAN 了 。 


6.5 发 布 gridgame 游 戏 包 


问题 


如 何 发 布 自己 的 R 软 件 包 ? 


发 布 gridgame 游 戏 包 
http://blog.fens.me/r-game-gridgame/ 


为 了 能 发 布 自己 的 游戏 包 ， 我 们 已 经 储备 了 很 多 的 基础 知识 ， 包 括 R 语 言 面 向 对 象 编 程 、R 包 开发 编程 、R 语 言 游 戏 编程 等 ， 最 后 一 步 就 到 综合 运用 的 时 候 了 。 按 CRAN 的 了 包 发 布 的 要 求 ， 把 所 有 代码 和 


文档 串 起 来 ， 就 是 我 们 要 发 布 的 gridgame 游 戏 包 。 


6.5.1 知识 储备 
在 综合 运用 所 有 知识 前 ， 先 回顾 一 下 ， 我 们 都 需要 掌握 哪些 知识 。 (1) R 语 言 编程 的 基础 是 必需 。 (2) 游戏 的 算法 主要 是 对 矩阵 操作 ， 线 性 代数 最 好 也 要 掌握 。 (3) 游戏 操作 需要 有 界面 ， 虽 然 不 需 


太 好 看 ， 但 我 们 也 要 有 能 力 用 代码 画 出 游戏 界面 来 。 (4) 游戏 的 框架 封装 ， 对 于 相同 类 型 的 游戏 ， 如 果 第 二 款 游戏 能 延续 第 一 款 游 戏 的 结构 ， 不 仅 能 简化 开发 节约 时 间 ， 还 能 降低 游戏 技术 门槛 ， 就 需要 


面向 对 象 的 思维 模式 对 游戏 框架 进行 封装 。 


1. 基 础 知识 
要 知识 点 ， 都 已 经 做 好 了 技术 准备 ， 针 对 不 同 问题 ， 参 考 不 同 章节 内 容 就 可 以 解决 。 


上 面 列 出 的 4 个 3 


“ 有 语言 面向 对 象 编程 : RR 语言 基于 RC 的 面向 对 象 编程 (4.4 节 ) o 
“ 人 语言 环境 空间 : 揭 开 R 语 言 中 环境 空间 的 神秘 面纱 (3.2 节 ) ， 解 密 RR 语言 函数 的 环境 空间 (3.3 节 ) o 
了 语言 游戏 编程 : R 语 言 键盘 和 鼠标 事件 (6.13) ， 贪 食 蛇 游戏 入 门 (6.2 节 ) ，R 语 言 游戏 框架 设计 (6.3 节 ) ，R 语 言 制作 游戏 2048 (6.4 节 ) o 


. 信 包 开发 编程 : 从 头 开发 自己 的 R 包 (5.1 节 ) ， 标 准 化 R 包 开发 流程 (5.2 节 ) 。 


2. 给 R 包 起 名 


game 作 为 项 目 名 字 ， 也 不 是 很 好 。 那 么 如 何 起 名 呢 ? 先 问 问 


技术 准备 一 切 就 绪 ， 先 给 项 目 起 个 名 字 吧 ! 其 实 ， 起 名 也 是 有 讲究 的 ， 不 能 太 随便 ， 虽 然 CRAN 上 面 没有 叫 game 的 包 ， 但 我 们 直接 上 


Google， 找 到 一 个 没有 太 多 重 名 的 关键 字 作为 名 字 。 


这 么 多 搜索 结果 去 竞争 关键 字 ， 是 我 们 在 推广 过 程 中 不 可 逾越 的 鸿沟 。 


直接 用 google 搜 索 'game' 有 1100000000 条 结果 ， 搜 索 'r game' 有 1680000000 条 结果 ， 如 图 6-20 所 示 。 我 连 0 都 数 不 过 来 了 ! 和 


Google game 


网 页 图 片 地 图 视频 新 闻 更 多 ~ 搜索 工具 


找到 约 1,100,000,000 条 结果 ‘用 时 0.32 $) 


小 提示 : 俊 限 搜索 简体 中 文 结果 。 您 可 以 在 设置 中 指定 搜索 语言 


GAME | Consoles & Games for Xbox 360, PS3, Wii, 3DS ... 
www.game.co.uk/ v 翻译 此 页 

GAME.co.uk is the UK's leading games retailer with great deals on video games, 
consoles, accessories and the latest preorder games. Free UK Delivery on all ... 


r game 


Quality Gaming Content and Discussion -- /r/Games - Reddit 
www.reddit com/r/Games ~ 德 译 此 页 

Ir/Games Game Discussion - Dynasty Warriors 2 (self. ... Today, Ron Gilbert, designer 
of several classic LucasArts games, posted the original design document 

New - Top scoring links : Games - Gilded - Rising 


图 6-20 ”game 关 键 字 


所 以 ,需要 换个 名 字 ， 让 我 们 从 小 成 长 ， 找 一 个 热度 不 是 那么 高 的 关键 字 作为 项 目 名 字 。gridgame 就 是 一 个 不 错 的 选择 ， 既 能 表现 游戏 的 特征 ， 从 推广 角度 又 没有 特别 强大 的 竞争 对 手 ， 一 下 子 压 力 全 
无 ， 倍 感 轻松 。Google 搜 索 结果 如 图 6-21 所 示 。 


Google gridgame 


视频 更 多 ~ 搜索 工具 


找到 约 283,000 条 结果 (用 时 0.16 $^) 


GRID Autosport - The Official Game Site 
www gridgame.com/ ~ 翻译 此 页 
Follow (Qgridgame - UK - US - FR - IT - DE - ES - BR - Terms & Conditions | Privacy 


Policy | Contact us | Sitemap. © 2014 The Codemasters Software Company 


Google r gridgame 


网 页 地 图 : 新 闻 视频 。 更 多 v 搜索 工具 


找到 约 419.000 条 结果 (用 时 0.41 4) 


您 是 不 是 要 找 : rgrid game 


gridgame - Reddit 
www.reddit.com/r/gridgame ~ 副 译 此 页 
submitted 8 days ago by AeternusNihil - comment; sharecancel. loading... 11. 0. 1. 2. 


How to redo races in Grid Autosport (self.gridgame). submitted 8 days ago .. 


图 6-21  gridgame X 4t t 


做 好 了 各 种 准备 工作 ， 下 面 就 是 搞定 gridgame 包 了 ! 


6.5.2 gridgame 包 开发 
按照 5.2 节 中 介绍 的 标准 化 的 开发 流程 ， 进 行 gridgame 包 的 开发 。 
本 节 的 系统 环境 是 : 
- Windows 7 64bit 
eR: 3.1.1 x86_64-w64-mingw32/x64 (64-bit) 
+ Rtools31.exe 


* basic-miktex-2.9.5105.exe 


由 于 之 前 gridgame 包 开发 的 游戏 都 是 基于 Windows 平 台 的 ， 而 且 暂 时 不 打算 支持 Linux 平 台 运行 ， 所 以 我 们 选择 的 R 包 开发 环境 ， 也 应 该 是 Windows 平 台 。 后 文中 会 介绍 ， 为 什么 不 支持 Linux 平 台 运 
行 ，R 的 版 本 最 好 要 升级 到 3.1.1。 ( 坑 很 多 的 ， 要 一 点 一 点 地 填 ! ) 


1. 构 建 工程 
为 了 减少 工作 量 ， 提 高 开发 效率 ， 我 将 按照 devtools 包 的 开发 流程 进行 操作 。 首 先 ， 打 开 一 个 项 目 目录 ， 然 后 创建 项 目 骨架 。 


~R # 启动 R 程 序 
> setwd ("D: /workspace/R/app") # 进入 运行 目录 
> library (devtools) + 加 载 3 个 开发 工具 包 


> library (roxygen2) 

Loading required package: digest 

» library (testthat) 

> create (paste (getwd () , "/gridgame", sep-"") ) # 创建 项 目 骨架 
Creating package gridgame in /home/conan/R 

No DESCRIPTION found. Creating default: 

Package: gridgame 

Title: 

Description: 

Version: 0.1 

Authors8R: # getOptions ('devtools.desc.author') 

Depends: R (>= 3.0.1) 

License: # getOptions ('devtools.desc.license') 

LazyData: true 

> setwd (paste (getwd () , "/gridgame", sep-"") ) + 重 置 当 前 目录 
> dir (full.names-TRUE) + 查看 项 目 骨架 生成 的 文件 


[1] "./DESCRIPTION" "./man" MT sd 


2 .编写 代码 和 文档 


首先 编辑 DESCRIPTION 文件 ， 增 加 项 目的 描述 信息 。 


~ vi /home/conan/R/gridgame/DESCRIPTION 

Package: gridgame 

Type: Package 

Title: A game framework for R 

Version: 0.0.1 

Date: 2014-07-23 

AuthorsQR: c (person ("Dan", "Zhang", email = "bsspiritGégmail.com", role-c ("aut", "cre")) ) 

Maintainer: Dan Zhang 

Description: This package provides a general-purpose game framework for grid game in R. 
The package includes 2 games about snake and 2048. You can run the function snake () 
or g2048 () to startup the game. These games are only running on Window platform. 


License: GPL-3 
URL: http: //onbook.me/f/project/gridgame 
BugReports: https: //github.com/bsspirit/gridgame/issues 
OS type: windows 
Collate: 
'game.R' 
'2048.R' 
'package.R' 
'snake.R' 


DESCRIPTION 文件 中 ， 有 两 个 地 方 需要 注意 。 


(1) Imports: methods， 由 于 我 们 用 的 是 RC 类 型 ， 系 统 默 认 会 用 methods 包 中 的 函数 进行 解析 ， 必 须 在 这 里 显示 声明 。 


(2) OS type: Windows， 由 于 只 仅 支 持 Window 系 统 运行 ， 因 此 在 后 面 上 传 到 CRAN 检 查 时 ， 必 须 指明 支持 的 系统 。 同 时 ， 也 是 由 于 增加 了 这 个 属性 ， 再 到 Linux 中 执行 R CMD check 过 程 的 时 候 会 
自动 失败 ， 因 此 要 求 我 们 只 能 在 windows 系 统 中 进行 打包 和 发 布 的 操作 。 


然后 ， 复 制 我 们 已 经 完成 的 3 个 R 文 件 到 /home/conan/R/gridgame/R 目 录 下 面 。 


me 

-rw-rw-r-- 1 conan conan 5030 7H 23 17: 23 2048.R 
-rw-rw-r-- 1 conan conan 2151 75H 23 17: 18 game.R 
-rw-rw-r-- 1 conan conan 5204 7A 23 17: 23 snake.R 


我 们 需要 对 代码 进行 再 整理 ， 都 是 检查 失败 错误 。 
“去掉 2048.R 和 snake.R 代 码 中 source () 函数 对 game.R 文 件 的 引用 。 
“去掉 代码 中 所 有 中 文 注释 ， 只 能 是 ASCII 码 支持 的 字符 。 
“ 在 代码 中 增加 Windows 平 台 检 查 ， 非 Windows 则 禁止 运行 ， 通 过 .Platform$OS.type==”windows” 人 代码， 判断 运行 时 的 系统 环境 。 
* 增加 package.R 文 件 ， 用 于 加 载 methods 包 的 配置 信息 ，#” @import methods. 
“去掉 代码 中 启动 函数 ， 启 动 交 给 用 户 来 操作 。 
3. 调 试 程序 


在 Windows 系 统 开发 环境 中 ， 通 过 load_all () 函数 加 载 程序 包 ， 然 后 运行 snake () 函数 或 者 g2048 () 函数 ， 一 切 正常 。 


> load all (getwd () ) + 加 载 程序 包 

Loading gridgame 

> snake () * 启动 snake 游 戏 
> g2048 () # 启动 2048 游 戏 


我 们 写 的 游戏 程序 ， 都 是 在 Windows 7 下 开发 的 ， 运 行 一 切 正常 ， 那 么 为 什么 不 支持 在 Linux 系 统 中 运行 呢 ? 主要 原因 是 Linux 和 Windows 中 有 不 同 的 图 形 设备 输出 。Windows 系 统 中 ， 输 出 设备 是 通 
过 .net 框 架 来 支持 的 ;而 Linux 系 统 中 的 输出 设备 是 X11 () 显示 驱动 支持 ， 或 者 通过 在 Linux 系 统 中 加 载 第 三 方 的 TK 设 备 支持 ，R 语 言 通过 tkrplot 包 来 实现 调 


~ sudo apt-get install tk-dev 
» install.packages ("tkrplot") 


Windows 系 统 和 Linux 系 统 对 于 运行 GUI 程序 是 有 区 别 的， 无 法 统一 用 一 套 代 码 来 完成 。 有 人 会 说， 每 个 地 方 都 增加 系统 类 型 的 判断 条 件 就 能 实现 了 。 


当然 情况 并 不 是 这 么 简单 ， 除 了 输出 设备 的 问题 以 外 ，Linux 上 面 还 会 遇 到 字体 的 问题 ， 字 库 不 全 将 导致 字符 加 载 失败 的 错误 。 下 面 的 问题 ，Linux 系 统 中 没有 helvetica 的 60 号 字体 。 


label = name, cex = 5) 


Error in text.default (0.5, A 
$s-*-*-$d-*-*-*-*-*-*-*. face 1 at size 60 could not be loaded 


X11 font -adobe-helvetica-$ 


虽然 在 Linux Ubuntu 环境 中 ， 我 法 试 了 安装 所 有 字体 库 ， 仍 然 无 法 解决 大 号 字体 的 加 载 问题 。 所 以 ， 我 决定 暂时 不 支持 Linux 平 台 ， 等 以 后 有 时 间 再 解决 这 个 问题 。 


~ sudo apt-get install xfont-100dpi xfont-75dpi xfont-cyrillic xfont-* 


4 单元 测试 


在 inst/test 目 录 下 面 ， 我 们 分 别针 对 不 同 的 文件 ， 创 建 单元 测试 类 。 


' test-game.R， 对 game.R 的 函数 进行 单元 测试 。 
- test-snake.R， 对 snake.R 的 函数 进行 单元 测试 。 


“test-2048.R， 对 2048.R 的 函数 进行 单元 测试 。 


以 test-game.R 为 例 ， 打 开 test-game.R 文 件 。 


— vi inst/test/test-game.R 
context ("game") 
test that ("Initial the construct function of Game class", { 
name«-"R" 
width«-height«-10 
game«-Game$new () 
gameSinitFields (name-name, width-width, height-height) 
expect that (game$name, equals (name) ) 
expect that (game$width, equals (width) ) 
expect that (gameSheight, equals (height) ) 
p 


执行 单元 测试 代码 。 


> test (getwd () ) 

Testing gridgame 

Loading gridgame 

game : http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... 


5.88 


R 包 开发 中 最 繁琐 的 一 个 过 程 ， 就 是 撰写 LaTex 格 式 的 文档 。 幸 好 有 人 发 明了 roxygen2 包 ， 通 过 简单 的 注释 规则 来 生成 LaTex 文 档 。 


我 们 用 roxygen2 包 来 生成 man/*.Rd 的 文档 文件 ， 对 RC 类 型 的 程序 ， 其 实 就 可 以 偷 点 懒 了 ， 只 是 在 类 的 定义 上 ， 增 加 注释 就 行 了 。RC 类 中 方法 的 注释 ， 就 没 强制 的 检查 ， 多 写 少 写 就 看 开发 者 的 心情 
了 。 如 果 是 S3 的 编程 方式 或 者 纯 函 数 式 的 包 ， 那 么 写 文档 也 是 很 辛苦 的 工作 。 另 外 ， 文 件 不 能 出 现 中 文字 符 ， 不 然 check 过 程 的 时 候 ， 还 是 会 有 警告 发 生 的 。 


以 snake.R 文 件 中 注释 为 例 ， 我 们 只 写 setRefClass 的 注释 和 snake<-function () { 的 注释 就 行 了 ，Snake 类 的 内 部 方法 暂时 就 省 略 了 。 后 面 有 时 间 我 会 再 补充 文档 的 ， 多 写 点 文档 没 坏 处 。 


~ vi snake.R 
#' Snake game class 
#' Ginclude game.R 
Snake«-setRefClass ("Snake", contains-"Game", 
http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/...) 
#' Snake game function = 
p 
#' Gexport 
snake<-function () { 
game<-Snake$new () 
game$initFields () 
game$run () 


} 


通过 代码 中 的 注释 生成 LaTex 文 件 。 


> document (getwd () ) 

Updating gridgame documentation 
Loading gridgame 

Writing G2048-class.Rd 

Writing g2048.Rd 

Writing Game-class.Rd 

Writing Snake-class.Rd 

Writing snake.Rd 


打开 snake.Rd 文 件 ， 看 看 生成 的 内 容 。 


~ vi man/snake.Rd 

$ Generated by roxygen2 (4.0.1) : do not edit by hand 
Mname [snake] 

Nalias([snake] 

Ntitle(Snake game function) 

Nusaget 

snake () 

} 

\description{ 

Snake game function 


) 


这 一 步 的 操作 过 程 ， 其 实 也 不 是 一 帆 风 顺 的 。 在 引用 roxygen2 包 的 时 候 ， 我 遇 到 了 同样 的 问题 。 在 Windows 环 境 中 ，roxygen2 包 依赖 于 R 3.0.2 以 上 的 版 本 ，R 3.0.1 版 本 的 R 程 序 装 不 上 roxygen2 包 。 
github 有 对 这 个 强 依赖 问题 的 描述 见 https://github.com/klutometis/roxygen/issues/163。 所 以 ， 文 中 建议 在 R 3.1.1 的 版 本 环境 ， 是 实践 检验 出 来 的 。 


6 .程序 检查 


程序 检查 这 一 步 其 实 是 所 有 操作 过 程 最 容易 出 错 的 ， 也 不 一 定 能 搞定 。R 的 打包 的 检查 真 的 很 严格 ! 


在 Windows 平 台中 开发 R 包 ， 要 额外 装 两 个 软件 ， 即 Rtools (http://cran.us.r-project.org/bin/windows/Rtools/) 和 MikTeX (http://www.miktex.org/download) ， 不 仅 版 本 要 和 R 语 言 环境 匹配 
上 ， 环 境 变量 也 要 配置 对 。 本 节 中 Rtools 版 本 为 Rtools version 3.1.0.1942，MikTeX 对 应 的 版 本 为 2.9.4533。MikTeX 在 调用 过 程 中 ， 还 会 遇 到 文件 找 不 到 ，pdflatex.exe 运 行 错误 等 问题 。 比 如 ， 其 中 的 一 
个 常见 错误 : 


* checking PDF version of manual http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... WARNING 

LaTeX errors when creating PDF version. T 

This typically indicates Rd problems. 

LaTeX errors found: ! pdfTeX error: pdflatex.EXE (file tsl-zi4r) : Font tsl-zi4r at 540 not found 

==> Fatal error occurred, no output PDF file produced! 

* checking PDF version of manual without hyperrefs or index http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... ERROR 


解决 方法 是 在 命令 行 运行 下 面 的 命令 。 


~ updmap- initexmf --update-fndb- initexmf --edit-config-file updmap # 打开 文件 
Map zi4.map # 在 文件 中 增加 ~ initexmf --mkmaps 


最 后 ， 经 过 九 九 八 十 一 难 ， 终 于 修成 正果 ， 一 切 顺 利 地 完成 了 ! 


> check (getwd () ) 

Updating gridgame documentation 

Loading gridgame 

Writing NAMESPACE 

Writing G2048-class.Rd 

Writing g2048.Rd 

Writing Game-class.Rd 

Writing Snake-class.Rd 

Writing snake.Rd 

"C: /PROGRA-1/R/R-30-1.3/bin/x64/R" --vanilla CMD build V 


"D: NworkspaceMRNVappNgridgame" --no-manual --no-resave-data 


checking 


for file 'D: WorkspaceWwNappNgridgame/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


preparing 'gridgame': 


checking 
checking 


* 
* 
* checking 
* 
* 
* building 


DESCRIPTION meta-information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
for LF line-endings in source and make files T 

for empty or unneeded directories 

'gridgame_0.0.1.tar.gz' 


"C: /PROGRA-1/R/R-30-1.3/bin/x64/R" --vanilla CMD check V 
"C: NUsersVADMINI-1NAppDataMLocalNTempNREmponOeAc/gridgame 0.0.1.tar.gz" VW 
--timings 


checking 
checking 


checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 
checking 


using log directory 'C: /Users/ADMINI-1/AppData/Local/Temp/RtmponOeAc/gridgame .Rcheck"' 
using R version 3.0.3 (2014-03-06) 

using platform: x86 64-w64-mingw32 (64-bit) 

using session charset: ASCII 


for file 'gridgame/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
extension type http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... Package 


this is package 'gridgame' version '0.0.1' 


package namespace information http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

package dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

if this is a source package http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

if there is a namespace http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

for executable files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

for hidden files and directories http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

for portable file names http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

whether package 'gridgame' can be installed http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 
installed package size http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

package directory http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

DESCRIPTION meta-information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

top-level files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

for left-over files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

index information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

package subdirectories http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

R files for non-ASCII characters http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

R files for syntax errors http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

whether the package can be loaded http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

whether the package can be loaded with stated dependencies http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/.. 
whether the package can be unloaded cleanly http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 
whether the namespace can be loaded with stated dependencies http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/ 
whether the namespace can be unloaded cleanly http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 
loading without being on the library search path http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


checking dependencies in R code http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking S3 generic/method consistency http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking replacement functions http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking foreign function calls http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking R code for possible problems http: //www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking Rd files http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking Rd metadata http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking Rd cross-references http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 

checking for missing documentation entries http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
checking for code/documentation mismatches http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 
checking Rd \usage sections http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/O0EBPS/Text/... OK 

checking Rd contents http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking for unstated dependencies in examples http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/0EBPS/Text/... OK 
checking examples http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 

checking PDF version of manual http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
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在 执行 check 过 程 中 ， 你 的 项 目 里 可 能 会 有 其 他 的 文件 ， 因 而 检查 通 不 过 。 你 可 新 建 一 个 文件 .Rbuildignore， 通 过 这 个 文件 进行 配置 ， 忽 略 不 希望 参与 打包 的 文件 。 


~ vi .Rbuildignore 
.gitignore 

dist 

^.*A.Rproj$ 

^N. RprojN.user$ 
README* 

NEWS* 


跳 过 不 希望 参与 打包 的 一 些 帮助 文件 ， 就 能 通过 检查 了 。 


7. 程 序 打包 


在 检查 通过 以 后 ， 我 们 就 可 以 自由 地 打包 了 ， 用 build 命 令 。 有 2 种 打包 方式 选择 ， 即 源 代 码 打包 和 二 进 打包 。 默 认 是 给 源 代 码 打 包 。 


> build () 
"C: /PROGRA-1/R/R-30-1.3/bin/x64/R" --vanilla CMD build V 
"D: WorkspaceWRNappVgridgame" --no-manual --no-resave-data 


checking for file 'D: \workspace\R\app\gridgame/DESCRIPTION' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 


* 
* preparing 'gridgame': 

* checking DESCRIPTION meta-information http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... OK 
* checking for LF line-endings in source and make files 

* checking for empty or unneeded directories 

* building 'gridgame 0.0.2.tar.gz' 

[1] "D: /workspace/R/app/gridgame 0.0.2.tar.gz" 


如 果 用 二 进 制 打包 ， 需 再 传 一 个 binary 的 参数 。 


> build (binary-TRUE) 
"C: /PROGRA-1/R/R-30-1.3/bin/x64/R" --vanilla CMD INSTALL V 
"D: \workspace\R\app\gridgame" --build 
* installing to library 'C: /Users/Administrator/AppData/Local/Temp/RtmpI3hhpp' 
* installing *source* package 'gridgame' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
** R 
** inst 
** preparing package for lazy loading 
** help 
*** installing help indices 
** building package indices 
** testing if installed package can be loaded 
*** arch = 1386 
*** arch - x64 
* MD5 sums 
packaged installation of 'gridgame' as gridgame 0.0.2.zip 
* DONE (gridgame) 
[1] "D: /workspace/R/app/gridgame 0.0.2.zip" 


这 两 个 打包 后 的 文件 ， 都 可 以 用 来 发 布 项 目 ， 用 户 下 载 后 可 以 直接 进行 安装 。 


4 安装 命令 ~ R CMD INSTALL gridgame 0.0.2.tar.gz 

* installing to library 'C: /UsersS/Administrator/R/win-library/3.0' 
* installing *source* package 'gridgame' http://www.hzcourse.com/resource/readBook?path-/openresources/teach ebook/uncompressed/15294/OEBPS/Text/... 
** R 

** inst 

** preparing package for lazy loading 

** help 

*** installing help indices 

** building package indices 

** testing if installed package can be loaded 

*** arch = 1386 

*** arch - x64 

* DONE (gridgame) 


6.5.3 gridgame 包 发 布 
最 后 一 步 ， 就 是 把 我 们 好 不 容易 开发 的 包 ， 发 布 到 资源 库 。 有 4 个 平台 可 以 发 布 我 们 做 好 的 R 包 。 
“ Github: 个 人 开源 发 布 平台 
“ R-Forge: R-Forge 发 布 平台 
< RForge: RForge 发 布 平台 
: CRAN: 及 的 官方 发 布 平台 


1.Github: 个 人 的 开源 发 布 平台 


在 Github 上 发 布 是 最 容易 的 ， 只 要 把 项 目 代码 上 传 到 Github 就 完成 了 ， 都 不 需要 做 check () 检查 。 基 于 Github 发 布 ， 需 要 用 到 包 管 理工 具 devtools 包 ， 我 把 gridgame 项 目 已 上 传 到 Github， 项 目地 
址 是 https://github.com/bsspirit/gridgame， 用 户 可 以 通过 下 面 两 种 方式 ， 直 接 从 Github 安 装 gridgame 项 目 。 


方法 一 : 使 用 devtools 包 ， 二 进 制 安装 。 


library (devtools) 
install github ("gridgame", "bsspirit") 


方法 二 : 通过 源 代码 安装 。 


git clone https: //github.com/bsspirit/gridgame.git 
R CMD BUILD gridgame 
R CMD INSTALL gridgame *.tar.gz 


2.R-Forge: R-Forge 发 布 平台 


在 R-Forge (https://r-forge.r-project.org/) 发 布 比较 麻烦 ， 需 要 先 注册 一 个 账号 ，https://r-forge.r-project.org/account/register.php， 登 陆 后 ， 再 新 建 一 个 项 目 ， 需 要 等 72 小 时 审核 才能 通过 。 


在 R-Forge 中 ，gridgame 项 目 管理 界面 截图 ， 如 图 6-22 所 示 。 


然后 ， 通 过 SVN 把 项 目的 源 代 码 提 交 上 去 。 如 果 我 们 用 习惯 了 Git 进 行 版 本 管理 ， 再 回 过 头 来 用 SVN， 感 觉 好 老 土 啊 ! 


在 R-Forge 平 台 上 提交 代码 ， 并 运行 通过 以 后 ,会 有 项 目 介绍 页 http://gridgame.r-forge.r-project.org/， 如 图 6-23 所 示 ， 其 他 开发 者 会 看 到 项 目 介绍 ， 下 载 你 的 包 。 


Log Out (Dan Zhang) | M 


P 

(©) |Search the entire project v | | | Search| Advanced Accour 
w Pea M 15-4. E t- | 
z-rorge 


search | Quick Jump To... v 


Home | My Page | | Projects | | gridgame 


Summary Admin Activity Lists SCM R Packages 


Project Information 
Project Information | Users and permissions | Tools | Project History | VHOSTs | Stats 


Misc. Project Information 


Group shell (SSH) server: gridgame.r-forge.r-project.org 


Group directory on shell server: 
Jvar/lib/gforge/chroot/home/groups/gridgame 


Project WWW directory on shell server: 
/ var/lib/gforge/chroot/home/groups/ gridgame/ htdocs 


Descriptive Project Name 


grnágame 


Short Description 


Maximum 255 characters, HTML will be stripped from this description 


This package provides a general-purpose game framework for grid game in R. The 
package includes 2 games about snake and 2048. You can run the function snake[) 
or g2046() to startup the game. These games are only running on Window platform. < 


Project tags 


Add tags (use comma as separator): 
game, 2048, snake 
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© [3gridgame.r-forge.r-project.org 
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@ -Forge 


Welcome to gridgame project! 


This package provides a general-purpose game framework for grid game in R. The package includes 
2 games about snake and 2048. You can run the function snake or g2048() to startup the game. 
[heESE zames are only running on Window plattorm. 


Mo content added. 


图 6-23 R-Forge-F & fj girdgame7ft H 


可 以 直接 查看 项 目 信息 (http://gridgame.r-forge.r-project.org/) ， 也 可 以 在 线 查 看 项 目 源 代码 (https://r-forge.r-project.org/scm/viewvc.php/root=gridgame) ，R-Froge 平 台 会 每 天 自 
动 打包 一 次 。 


3.RForge: RForge 发 布 平台 


此 RForge (http://rforge.net/) 非 彼 R-Froge， 但 是 两 个 名 字 如 此 相似 ， 第 一 次 用 的 人 肯定 会 混淆 的 。 首 先 注册 RForge 账 号 ， 同 时 注册 一 个 要 发 布 的 项 目 ， 如 图 6-24 所 示 。gridgame 项 目 , 我 已 经 上 


传 到 Github 了 ， 这 边 能 直接 导入 Github 项 目 ， 非 常 方便 。 


€ > C ü&bhbupt//www.rforge.net/do/rf/eng/request.htrml 
站: 应 用 O 应 用 E Googe FJ Googl? 四 Rstudio 


Back to RForge Main Menu 


Request an RForge account 


IMPORTANT: Are you sure youre in the right place? This is NOT the R-Forge as run by the R Foundation 
(see last paragraph below). If in doubt, contact me directly at Sinon. Urbanek6R-project. org 


Login name: bsspirit | ([A-7a-z][A-7a-z0-9. '-]* only) 


Ful name: Dan Zhang | 


e-Mail: [bespirit@gmail.com 


You need a valid e-mail address in order to receive the activation e-mail. 
Project/package name: gidgame ^ | (This will be the name of the SVN repository 

and also the package name if the project is an R package) 
Project (short info): gndgam — | 

(Mention briefly why you want an account and what is your project about.) 
Source: | want Lo import my project from an existing GIT repository hi | 


|; Request 


Note: RForge accounts are currently granted only ff the auhenticity of the individual can be verified in order to 
prevent abuse. Spammer accounts such as hotmail, yahoo, AOL, etc. are likely to get rejected. 


Just to make sure you know your options - this is www.rforge.net - a site created specifically from the 
beainning for R package development. This is not the R-Forge run by R-Foundation - the latter can be 
found at http-//r-forge.r-project.org and has a different philosophy. 


6-24 ”RForge 平 台 


通过 RForge 源 下 载 gridgame 包 ， 可 以 直接 用 install.packages () 函数 。 


install.packages ('gridgame', repos = 'http: //rforge.net') 


xk 项 目 未 发 布 成 功 ， 请 先 用 Github 的 方案 


4.CRAN 发 布 : R 的 官方 发 布 平台 


在 这 4 个 发 布 平台 中 ，CRAN 是 最 全 威 的 ， 因 为 它 是 官方 的 ， 当 然 ， 它 也 是 最 难 发 布 的 ， 有 很 严格 的 审查 机 制 。CRAN 发 布 条 款 可 参见 http://cran.r-project.org/web/packages/policies.html。 我 们 读 
完 政策 后 ， 通 过 http://cran.r-project.org/submit.html| 提 交 项 目 ， 大 概要 等 待 48 小 时 审查 。 可 能 我 这 个 包 的 问题 比较 严重 ，6 个 小 时 内 有 就 了 回复 。 


“ 第 一 次 不 合格 : 没有 标 出 只 支持 Windows 平 台 ， 对 应 DESCRIPTION 文 件 中 OS_type: Windowse (当然 ， 他 是 不 会 告诉 你 怎么 改 的 ， 自 己 用 Google 找 吧 。) 
“ 第 二 次 不 合格 : Linux 平 台 R CMD check 出 错 。 (加 了 OS_type 后 ，Linux 执 行当 然 会 出 错 了 ， 老 外 似乎 也 晕 了 。) 


“第 三 次 不 合格 : 为 什么 Linux 不 能 用 ， 为 什么 用 .Platform$OS.type 的 代码 检查 ，getGraphicsEvent 在 没有 GUI 的 环境 中 怎么 办 ， 文 档 不 全 ， 对 game framewotk 的 定义 不 清楚 。 (笔者 觉 了 好 大 劲 解释 ， 把 这 
几 篇 文章 的 设计 理念 ， 写 了 封 总 结 的 邮件 。) 
- 第 四 次 不 合格 : 这 次 Uwe Ligges 的 态度 很 强硬 ， 必 须 把 Rd 写 完整 ， 必 须 支 持 至 少 2 个 平台 ， 必 须 对 getGraphicsEvent 进 行 检查 ， 必 须 处 理 OS.type 的 代码 问题 ， 没 有 商量 的 余地 ， 不 搞定 就 不 给 发 布 。 (我 


真是 悲剧 了 ， 看 来 发 布 项 目 ， 又 要 延期 了 。) 


下 面 是 提交 项 目 到 CRAN 的 过 程 。 


第 一 步 : 填写 用 户 基本 信息 ， 并 上 传 打 好 的 tar.gz 包 ， 如 图 6-25 所 示 。 


第 二 步 : 核对 DESCRIPTION 文件 中 的 描述 ， 与 网 页 自动 解析 的 内 容 是 否 一 致 ， 如 图 6-26 所 示 。 


package to 


Step 1 Step 2 
(Upload) (Submission) 


bsspirit | 


J 


lour email*: bsspiritgmail.com | 
选择 文件 | gridgame. 0.0.2 tar.gz 


(+, tar.gz files only, max 100 MB size) 


Dptional comment: 


: Required Fields 


Before uploading please ensure the following: 
The package contains a DESCRIPTION file 
DESCRIPTION file contains valid maintainer field "NAME «EMAIL»" 
You are familiar with the CRAN policies 


If upload times out (long upload times), contact CRAN team directly 


图 6-25 CRAN 发 布 第 一 步 


Step 1 
(Upload) (Submi ssion) 


Package successfully uploaded 


Ibsspirit 


lour email: Ibsspirit)gmail.com 


选择 文件 | 未 选择 文件 


Ck. tar.gz files only, max 100 MB size) 


Dptional comment: 


Re-upload package/Edit information | 


Detected package information [non-editable] 


gridgame 


0.0.2 


À game framework for R 


图 6-26 CRAN 发 布 第 二 步 


第 三 步 : 等 待 审核 ， 如 图 6-27 所 示 。 


Submit package to CRAN 


Step 1 Step 2 Step 3 


(Upload) (Submission) (Confirmation) 


The maintainer of this package has been sent an email to confirm the submission. After their 
confirmation the package will be passed to CRAN for review. 


图 6-27 CRAN 发 布 第 三 步 


第 一 次 不 合格 ， 老 外 回复 的 邮件 : 


On 25/07/2014 04: 24, Dan Zhang wrote: 
» [This was generated from CRAN.R-project.org/submit.html] 
= 


> 

> Package Information: 

> Package: gridgame 

> Version: 0.0.1 

> Title: A game framework for R 

> Author (s) : Dan Zhang [aut, cre] 

> Maintainer: Dan Zhang 

> Depends: R (>= 3.0.1) 

> Description: This package provides a general-purpose game framework for 
'This package provides' is redundant. 

> grid game in R. The package includes 2 games about snake and 

> 2048. You can run the function snake () or g2048 () to startup 
区 the game. These games are only running on Window platform. 

Eh The CRAN policies do not allow such a package, and you have not 
marked this as Windows-only. 

> License: GPL-3 

> Imports: methods 


The maintainer confirms that he or she 
has read and agrees to the CRAN policies. 


Submitter's comment: This package provides a general-purpose game 
framework for grid game in R. The package includes 2 
games about snake and 2048. You can run the function 
snake () or g2048 () to startup the game. These games 
are only running on Window platform. 


1IVvvvvvvvvvv 


Brian D. Ripley, ripley8stats.ox.ac.uk 
Professor of Applied Statistics, 
University of Oxford, Tel: 
1 South Parks Road, 


+44 1865 272866 (PA) 
Oxford OX1 3TG, UK 


Fax: +44 1865 272595 


经 过 多 次 的 对 决 和 修改 ， 笔 者 多 么 想 阅 “终于 把 包 成 功 发 布 到 了 CRAN 
面 的 代码 〈 目 前 还 在 修改 中 ) 。 


， 但 是 最 后 的 结果 是 被 要 求 继续 修改 ， 确 实 是 折磨 啊 。 如 果 gridgame 包 在 CRAN 发 布 成 功 ， 上 


http: //www.stats.ox.ac.uk/-ripley/ 
+44 1865 272861 (self) 


户 安装 时 就 方便 了 ， 可 以 通过 下 


* 从 CRAN 下 载 gridgame 包 


install.packages ('gridgame') # 未 发 布 成 功 ， 请 先 用 Github 的 方案 


library (gridgame) # 加 载 gridgame 包 
snake () E 启动 贪 食 蛇 游戏 
g2048 () # 启动 2048 游 戏 


在 CRAN 上 发 布 一 个 R 包 ， 真 不 是 一 件 轻松 的 事情 ! 坚持 ， 修 改 ， 打 磨 ， 再 坚持 ， 虽 然 过 程 


们 ， 都 能 完成 在 CRAN 上 发 布 自己 的 R 包 。 


香 很 痛苦 ， 但 是 软件 质量 最 终 得 到 了 保证 ， 这 就 是 CRAN 严 格 审查 的 意义 。 希 望 准备 在 R 领 域 深入 研究 的 朋友 


到 这 里 为 止 ， 本 书 的 正文 部 分 就 结束 了 ， 感 谢 你 的 阅读 。 希 望 这 本 书 能 让 你 更 深入 地 了 解 R 语 言 ， 掌 


域 的 应 用 ， 告 诉 读者 如 何 让 技术 真正 变 成 价值 ， 让 属 丝 程序 员 也 能 逆 袭 。 我 很 期 待 你 能 


语言 ， 掌 握 R 语 言 的 思维 模式 。 另 外 ， 下 一 本 书 《R 的 极 客 理想 一 一 量化 投资 篇 》 将 会 为 你 介绍 R 语 言 在 金融 领 
本 书 里 学 到 的 知识 ， 做 出 不 一 样 的 应 用 。 


